Diff for /loncom/homework/edit.pm between versions 1.57.2.3 and 1.96

version 1.57.2.3, 2003/10/15 21:19:46 version 1.96, 2005/11/15 15:57:45
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 3/20 Guy  
 # 01/10/02 Matthew  
 # 03/06/02 Matthew  
 package Apache::edit;   package Apache::edit; 
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet;
 use HTML::Entities();  use HTML::Entities();
   use Apache::lonlocal;
   
 # Global Vars  # Global Vars
 # default list of colors to use in editing  # default list of colors to use in editing
Line 45  $Apache::edit::bgimgsrc=''; Line 44  $Apache::edit::bgimgsrc='';
 $Apache::edit::bgimgsrccurdepth='';  $Apache::edit::bgimgsrccurdepth='';
   
 sub initialize_edit {  sub initialize_edit {
   $Apache::edit::colordepth=0;      $Apache::edit::colordepth=0;
   @Apache::edit::inserttag=();      @Apache::edit::inserttag=();
 }  }
   
 sub tag_start {  sub tag_start {
   my ($target,$token,$description) = @_;      my ($target,$token,$description) = @_;
   my $result='';      my $result='';
   if ($target eq "edit") {      if ($target eq "edit") {
     my $tag=$token->[1];   my $tag=$token->[1];
     if (!$description) {   if (!$description) {
       $description=&Apache::lonxml::description($token);      $description=&Apache::lonxml::description($token);
       if (!$description) { $description="<$tag>"; }      if (!$description) { $description="<$tag>"; }
     }   }
     $result.= &start_table($token)."<tr><td>$description</td>   $result.= &start_table($token)."<tr><td>$description</td>
 <td>Delete".                        <td>Delete".
   &deletelist($target,$token)        &deletelist($target,$token)
   ."</td>        ."</td>
 <td>".                         <td>".
     &insertlist($target,$token).&end_row().&start_spanning_row();         &insertlist($target,$token);
 #<td>".   #<td>". 
 #  &movebuttons($target,$token).  #  &movebuttons($target,$token).
 #    "</tr><tr><td colspan=\"3\">\n";  #    "</tr><tr><td colspan=\"3\">\n";
   }   my @help = Apache::lonxml::helpinfo($token);
   return $result;   if ($help[0]) {
       $result .= '</td><td align="right" valign="top">' .
    Apache::loncommon::help_open_topic(@help);
    } else { $result .= "</td><td>&nbsp;"; }
    $result .= &end_row().&start_spanning_row();
       }
       return $result;
 }  }
   
 sub tag_end {  sub tag_end {
   my ($target,$token,$description) = @_;      my ($target,$token,$description) = @_;
   my $result='';      my $result='';
   if ($target eq 'edit') {      if ($target eq 'edit') {
     $result.="</td></tr>".&end_table()."\n";   $result.="</td></tr>".&end_table()."\n";
   }      }
   return $result;      return $result;
 }  }
   
 sub start_table {  sub start_table {
   my ($token)=@_;      my ($token)=@_;
   my $tag = $token->[1];      my $tag = $token->[1];
   my $tagnum;      my $tagnum;
   foreach my $namespace (reverse @Apache::lonxml::namespace) {      foreach my $namespace (reverse @Apache::lonxml::namespace) {
     my $testtag=$namespace.'::'.$tag;   my $testtag=$namespace.'::'.$tag;
     $tagnum=$Apache::lonxml::insertlist{"$testtag.num"};   $tagnum=$Apache::lonxml::insertlist{"$testtag.num"};
     if (defined($tagnum)) { last; }   &Apache::lonxml::debug(" $testtag ");
   }   if (defined($tagnum)) { last; }
   if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }      }
   my $color = $Apache::lonxml::insertlist{"$tagnum.color"};      if (!defined ($tagnum)) {$tagnum=$Apache::lonxml::insertlist{"$tag.num"};}
   if (!defined($color)) {      my $color = $Apache::lonxml::insertlist{"$tagnum.color"};
     $color = $Apache::edit::colorlist[$Apache::edit::colordepth];      &Apache::lonxml::debug(" $tagnum -- $color");
   }      if (!defined($color)) {
   $Apache::edit::colordepth++;   $color = $Apache::edit::colorlist[$Apache::edit::colordepth];
   push(@Apache::edit::inserttag,$token->[1]);      }
   my $result='<div align="right">';      $Apache::edit::colordepth++;
   $result.='<table bgcolor="'.$color.'" width="97%" border="0" cellspacing="5" cellpadding="3">';      push(@Apache::edit::inserttag,$token->[1]);
   return $result;      my $result='<div align="right">';
       $result.='<table bgcolor="'.$color.'" width="97%" border="0" cellspacing="5" cellpadding="3">';
       return $result;
 }  }
   
 sub end_table {  sub end_table {
   $Apache::edit::colordepth--;      $Apache::edit::colordepth--;
   my $result='</table></div>';      my $result='</table></div>';
   $result.="<table><tr><td>";      $result.='<div align="left"><table><tr><td>';
   
   my ($tagname,$closingtag);      my ($tagname,$closingtag);
   if (defined($Apache::edit::inserttag[-2])) {      if (defined($Apache::edit::inserttag[-2])) {
     $tagname=$Apache::edit::inserttag[-2];   $tagname=$Apache::edit::inserttag[-2];
   } else {$tagname='problem';}      } else {$tagname='problem';}
   if (defined($Apache::edit::inserttag[-1])) {      if (defined($Apache::edit::inserttag[-1])) {
     $closingtag=$Apache::edit::inserttag[-1];   $closingtag=$Apache::edit::inserttag[-1];
   }      }
   $result.=&innerinsertlist('edit',$tagname,$closingtag).      $result.=&innerinsertlist('edit',$tagname,$closingtag).
     "</td></tr></table>";   "</td></tr></table></div>";
   pop(@Apache::edit::inserttag);      pop(@Apache::edit::inserttag);
   return $result;      return $result;
 }  }
   
 sub start_spanning_row { return '<tr><td colspan="3" bgcolor="#DDDDDD">';}  sub start_spanning_row { return '<tr><td colspan="4" bgcolor="#DDDDDD">';}
 sub start_row          { return '<tr><td bgcolor="#DDDDDD">';            }  sub start_row          { return '<tr><td bgcolor="#DDDDDD">';            }
 sub end_row            { return '</td></tr>';          }  sub end_row            { return '</td></tr>';          }
   
 sub movebuttons {  sub movebuttons {
   my ($target,$token) = @_;      my ($target,$token) = @_;
   my $result='<input type="submit" name="moveup.'.      my $result='<input type="submit" name="moveup.'.
     $Apache::lonxml::curdepth.'" value="Move Up" />';   $Apache::lonxml::curdepth.'" value="Move Up" />';
   $result.='<input type="submit" name="movedown.'.      $result.='<input type="submit" name="movedown.'.
     $Apache::lonxml::curdepth.'" value="Move Down" />';   $Apache::lonxml::curdepth.'" value="Move Down" />';
   return $result;      return $result;
 }  }
   
 sub deletelist {  sub deletelist {
   my ($target,$token) = @_;      my ($target,$token) = @_;
   my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">      my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
 <option></option>  <option></option>
 <option>Yes</option>  <option>Yes</option>
 </select>";  </select>";
   return $result;      return $result;
 }  }
   
 sub handle_delete {  sub handle_delete {
   if (!$ENV{"form.delete_$Apache::lonxml::curdepth"}) { return ''; }      if (!$env{"form.delete_$Apache::lonxml::curdepth"}) { return ''; }
   my ($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   my $result=0;      my $result=0;
   if ($space) {      if ($space) {
     my $sub1="$space\:\:delete_$token->[1]";   my $sub1="$space\:\:delete_$token->[1]";
     {   {
       no strict 'refs';      no strict 'refs';
       if (defined &$sub1) {      if (defined &$sub1) {
  $result=&$sub1($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);   $result=&$sub1($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
       }      }
     }   }
   }      }
   if (!$result) {      if (!$result) {
     my $endtag='/'.$token->[1];   my $endtag='/'.$token->[1];
     my $bodytext=&Apache::lonxml::get_all_text($endtag,$parser);   my $bodytext=&Apache::lonxml::get_all_text($endtag,$parser);
     $$parser['-1']->get_token();   $$parser['-1']->get_token();
     &Apache::lonxml::debug("Deleting :$bodytext: for $token->[1]");   &Apache::lonxml::debug("Deleting :$bodytext: for $token->[1]");
     &Apache::lonxml::end_tag($tagstack,$parstack,$token);   &Apache::lonxml::end_tag($tagstack,$parstack,$token);
   }      }
   return 1;      return 1;
 }  }
   
 sub get_insert_list {  sub get_insert_list {
   my ($tagname) = @_;      my ($tagname) = @_;
   my $result='';      my $result='';
   my @tagnums= ();      my @tagnums= ();
   #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));      #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
   if ($Apache::lonxml::insertlist{"$tagname.which"}) {      if ($Apache::lonxml::insertlist{"$tagname.which"}) {
     push (@tagnums, @{ $Apache::lonxml::insertlist{"$tagname.which"} });   push (@tagnums, @{ $Apache::lonxml::insertlist{"$tagname.which"} });
   }      }
   foreach my $namespace (@Apache::lonxml::namespace) {      foreach my $namespace (@Apache::lonxml::namespace) {
     if ($Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"}) {   if ($Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"}) {
       push (@tagnums, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"} });      push (@tagnums, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"} });
     }   }
   }      }
   if (@tagnums) {      if (@tagnums) {
     my %options;   my %options;
     foreach my $tagnum (@tagnums) {   foreach my $tagnum (@tagnums) {
       my $descrip=$Apache::lonxml::insertlist{"$tagnum.description"};      my $descrip=$Apache::lonxml::insertlist{"$tagnum.description"};
       $options{$descrip} ="<option value=\"$tagnum\">".$descrip."</option>\n";      $options{$descrip} ="<option value=\"$tagnum\">".
     }   $descrip."</option>\n";
     foreach my $option (sort(keys(%options))) { $result.=$options{$option}; }   }
     if ($result) { $result='<option selected="on"></option>'.$result; }   foreach my $option (sort(keys(%options))) {$result.=$options{$option};}
   }   if ($result) { $result='<option selected="selected"></option>'.$result; }
   return $result;      }
       return $result;
 }  }
   
 sub insertlist {  sub insertlist {
   my ($target,$token) = @_;      my ($target,$token) = @_;
   return &innerinsertlist($target,$token->[1]);      return &innerinsertlist($target,$token->[1]);
 }  }
   
 sub innerinsertlist {  sub innerinsertlist {
   my ($target,$tagname,$closingtag) = @_;      my ($target,$tagname,$closingtag) = @_;
   my $result;      my $result;
   my $after='';      my $after='';
   if ($closingtag) {      if ($closingtag) {
      $after='_after_'.$closingtag;    $after='_after_'.$closingtag; 
   }      }
   if ($target eq 'edit') {      if ($target eq 'edit') {
     my $optionlist= &get_insert_list($tagname);   my $optionlist= &get_insert_list($tagname);
     if ($optionlist) {   if ($optionlist) {
       $result = "Insert:      $result = "Insert:
 <select name=\"insert$after\_$Apache::lonxml::curdepth\">              <select name=\"insert$after\_$Apache::lonxml::curdepth\">
 $optionlist                    $optionlist
 </select>"              </select>"
     } else {   } else {
       $result="&nbsp;";      $result="&nbsp;";
    }
     }      }
   }      return $result;
   return $result;  
 }  }
   
 sub handle_insert {  sub handle_insert {
   if ($ENV{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }      if ($env{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
   my $result;      my $result;
   my $tagnum = $ENV{"form.insert_$Apache::lonxml::curdepth"};      my $tagnum = $env{"form.insert_$Apache::lonxml::curdepth"};
   my $func=$Apache::lonxml::insertlist{"$tagnum.function"};      my $func=$Apache::lonxml::insertlist{"$tagnum.function"};
   if ($func eq 'default') {      if ($func eq 'default') {
     my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};   my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
     my $namespace;   my $namespace;
     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }   if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
     $result.="\n<$newtag>\n</$newtag>";   $result.="\n<$newtag>\n</$newtag>";
   } else {  
     if (defined(&$func)) {  
       {  
  no strict 'refs';  
  $result.=&$func();  
       }  
     } else {      } else {
       my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};   if (defined(&$func)) {
       &Apache::lonxml::error("Unable to insert tag $newtag, $func was not defined.");      {
    no strict 'refs';
    $result.=&$func();
       }
    } else {
       my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
       &Apache::lonxml::error("Unable to insert tag ".$Apache::lonxml::curdepth." ($tagnum) $newtag, func was not defined.");
    }
     }      }
   }      return $result;
   return $result;  
 }  }
   
 sub handle_insertafter {  sub handle_insertafter {
   my $tagname=shift;      my $tagname=shift;
   if ($ENV{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"} eq '')      if ($env{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"} eq '')
      { return ''; }      { return ''; }
   my $result;      my $result;
   my $tagnum =$ENV{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"};      my $tagnum =$env{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"};
   my $func=$Apache::lonxml::insertlist{"$tagnum.function"};      my $func=$Apache::lonxml::insertlist{"$tagnum.function"};
   if ($func eq 'default') {      if ($func eq 'default') {
     my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};   my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
     my $namespace;   my $namespace;
     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }   if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
     $result.="\n<$newtag>\n</$newtag>";   $result.="\n<$newtag>\n</$newtag>";
   } else {  
     if (defined(&$func)) {  
       {  
  no strict 'refs';  
  $result.=&$func();  
       }  
     } else {      } else {
       my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};   if (defined(&$func)) {
       &Apache::lonxml::error("Unable to insert (after) tag $newtag, $func was not defined. ($tagname $tagnum)");      {
    no strict 'refs';
    $result.=&$func();
       }
    } else {
       my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
       &Apache::lonxml::error("Unable to insert (after) tag $newtag, $func was not defined. ($tagname $tagnum)");
    }
     }      }
   }      return $result;
   return $result;  }
   
   sub insert_img {
       return '
       <img />';
 }  }
   
 sub insert_responseparam {  sub insert_responseparam {
   return '      return '
     <responseparam />';      <responseparam />';
 }  }
   
   sub insert_parameter {
       return '
       <parameter />';
   }
   
 sub insert_formularesponse {  sub insert_formularesponse {
   return '      return '
 <formularesponse answer="" samples="">  <formularesponse answer="" samples="">
     <textline />      <responseparam description="Numerical Tolerance" type="tolerance" default="0.00001" name="tol" />
       <textline size="25"/>
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </formularesponse>';  </formularesponse>';
 }  }
   
 sub insert_numericalresponse {  sub insert_numericalresponse {
   return '      return '
 <numericalresponse answer="">  <numericalresponse answer="">
   <responseparam type="tolerance" default="5%" name="tol" description="Numerical Tolerance" />
   <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
     <textline />      <textline />
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </numericalresponse>';  </numericalresponse>';
 }  }
   
   sub insert_customresponse {
       return '
   <customresponse>
       <answer type="loncapa/perl">
       </answer>
       <textline />
       <hintgroup>
       <startouttext /><endouttext />
       </hintgroup>
   </customresponse>';
   }
   
   sub insert_customresponse_answer {
       return '
       <answer type="loncapa/perl">
       </answer>
   ';
   }
   
 sub insert_stringresponse {  sub insert_stringresponse {
   return '      return '
 <stringresponse answer="" type="">  <stringresponse answer="" type="">
     <textline />      <textline />
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </stringresponse>';  </stringresponse>';
 }  }
   
 sub insert_essayresponse {  sub insert_essayresponse {
   return '      return '
 <essayresponse>  <essayresponse>
     <textfield></textfield>      <textfield></textfield>
 </essayresponse>';  </essayresponse>';
 }  }
   
 sub insert_imageresponse {  sub insert_imageresponse {
   return '      return '
 <imageresponse max="1">  <imageresponse max="1">
     <foilgroup>      <foilgroup>
         <foil>
         </foil>
     </foilgroup>      </foilgroup>
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </imageresponse>';  </imageresponse>';
 }  }
   
 sub insert_optionresponse {  sub insert_optionresponse {
   return '      return '
 <optionresponse max="10">  <optionresponse max="10">
     <foilgroup options="">      <foilgroup options="">
         <foil>
            <startouttext /><endouttext />
         </foil>
     </foilgroup>      </foilgroup>
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </optionresponse>';  </optionresponse>';
 }  }
   
   sub insert_organicresponse {
       return '
   <organicresponse>
       <textline />
       <hintgroup>
       <startouttext /><endouttext />
       </hintgroup>
   </organicresponse>';
   }
   
   sub insert_organicstructure {
       return '
   <organicstructure />
   ';
   }
   
 sub insert_radiobuttonresponse {  sub insert_radiobuttonresponse {
   return '      return '
 <radiobuttonresponse max="10">  <radiobuttonresponse max="10">
     <foilgroup>      <foilgroup>
         <foil>
            <startouttext /><endouttext />
         </foil>
     </foilgroup>      </foilgroup>
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </radiobuttonresponse>';  </radiobuttonresponse>';
 }  }
   
   sub insert_reactionresponse {
       return '
   <reactionresponse>
       <textline />
       <hintgroup>
       <startouttext /><endouttext />
       </hintgroup>
   </reactionresponse>';
   }
   
 sub insert_rankresponse {  sub insert_rankresponse {
   return '      return '
 <rankresponse max="10">  <rankresponse max="10">
     <foilgroup options="">      <foilgroup options="">
         <foil>
            <startouttext /><endouttext />
         </foil>
     </foilgroup>      </foilgroup>
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </rankresponse>';  </rankresponse>';
 }  }
   
 sub insert_matchresponse {  sub insert_matchresponse {
   return '      return '
 <matchresponse max="10">  <matchresponse max="10">
     <foilgroup options="">      <foilgroup options="">
       <itemgroup>        <itemgroup>
       </itemgroup>        </itemgroup>
         <foil>
            <startouttext /><endouttext />
         </foil>
     </foilgroup>      </foilgroup>
     <hintgroup>      <hintgroup>
       <startouttext /><endouttext />
     </hintgroup>      </hintgroup>
 </matchresponse>';  </matchresponse>';
 }  }
Line 359  sub insert_matchresponse { Line 447  sub insert_matchresponse {
 sub insert_displayduedate { return '<displayduedate />'; }  sub insert_displayduedate { return '<displayduedate />'; }
 sub insert_displaytitle   { return '<displaytitle />'; }  sub insert_displaytitle   { return '<displaytitle />'; }
 sub insert_hintpart {  sub insert_hintpart {
   return '      return '
 <hintpart on="default">  <hintpart on="default">
     <startouttext/>      <startouttext/><endouttext />
     <endouttext />  
 </hintpart>';  </hintpart>';
 }  }
   
 sub insert_numericalhint {  sub insert_hintgroup {
   return '    return '
   <hintgroup>
       <startouttext /><endouttext />
   </hintgroup>';
   }
   
   sub insert_numericalhint {
       return '
 <numericalhint>  <numericalhint>
 </numericalhint>';  </numericalhint>';
 }  }
   
 sub insert_stringhint {  sub insert_stringhint {
   return '      return '
 <stringhint>  <stringhint>
 </stringhint>';  </stringhint>';
 }  }
   
 sub insert_formulahint {  sub insert_formulahint {
   return '      return '
 <formulahint>  <formulahint>
 </formulahint>';  </formulahint>';
 }  }
   
 sub insert_radiobuttonhint {  sub insert_radiobuttonhint {
   return '      return '
 <radiobuttonhint>  <radiobuttonhint>
 </radiobuttonhint>';  </radiobuttonhint>';
 }  }
   
 sub insert_optionhint {  sub insert_optionhint {
   return '      return '
 <optionhint>  <optionhint>
 </optionhint>';  </optionhint>';
 }  }
   
 sub insert_startouttext {  sub insert_startouttext {
   return "<startouttext />\n<endouttext />";      return "<startouttext /><endouttext />";
 }  }
   
 sub insert_script {  sub insert_script {
   return "\n<script type=\"loncapa/perl\">\n</script>";      return "\n<script type=\"loncapa/perl\"></script>";
 }  }
   
 sub textarea_sizes {  sub textarea_sizes {
   my ($data)=@_;      my ($data)=@_;
   my $count=0;      my $count=0;
   my $maxlength=-1;      my $maxlength=-1;
   foreach (split ("\n", $$data)) {      foreach (split ("\n", $$data)) {
       $count+=int(length($_)/79);   $count+=int(length($_)/79);
       $count++;   $count++;
       if (length($_) > $maxlength) { $maxlength = length($_); }   if (length($_) > $maxlength) { $maxlength = length($_); }
   }      }
   my $rows = $count;      my $rows = $count;
   my $cols = $maxlength;      my $cols = $maxlength;
   return ($rows,$cols);      return ($rows,$cols);
 }  }
   
 sub editline {  sub editline {
     my ($tag,$data,$description,$size)=@_;      my ($tag,$data,$description,$size)=@_;
     $data=&HTML::Entities::encode($data);      $data=&HTML::Entities::encode($data,'<>&"');
     if ($description) { $description="<br />".$description."<br />"; }      if ($description) { $description="<br />".$description."<br />"; }
     my $result = <<"END";      my $result = <<"END";
 $description  $description
Line 431  END Line 525  END
 }  }
   
 sub editfield {  sub editfield {
   my ($tag,$data,$description,$minwidth,$minheight)=@_;      my ($tag,$data,$description,$minwidth,$minheight,$usehtmlarea)=@_;
   
   my ($rows,$cols)=&textarea_sizes(\$data);      my ($rows,$cols)=&textarea_sizes(\$data);
   if ($cols > 80) { $cols = 80; }      if (&Apache::lonhtmlcommon::htmlareabrowser() &&
   if ($cols < $minwidth ) { $cols = $minwidth; }   !&Apache::lonhtmlcommon::htmlareablocked()) {
   if ($rows < $minheight) { $rows = $minheight; }   $rows+=7;      # make room for HTMLarea
   if ($description) { $description="<br />".$description."<br />"; }   $minheight+=7; # make room for HTMLarea
   return $description."\n".'&nbsp;&nbsp;&nbsp;<textarea rows="'.$rows.      }
     '" cols="'.$cols.'" name="homework_edit_'.$Apache::lonxml::curdepth.'">'.      if ($cols > 80) { $cols = 80; }
       &HTML::Entities::encode($data).'</textarea>'."\n";      if ($cols < $minwidth ) { $cols = $minwidth; }
       if ($rows < $minheight) { $rows = $minheight; }
       if ($description) { $description="<br />".$description."<br />"; }
       if ($usehtmlarea) {
    push @Apache::lonxml::htmlareafields,'homework_edit_'.
       $Apache::lonxml::curdepth;
       }
       return $description."\n".'&nbsp;&nbsp;&nbsp;<textarea style="width:100%" rows="'.$rows.
    '" cols="'.$cols.'" name="homework_edit_'.
    $Apache::lonxml::curdepth.'" id="homework_edit_'.
    $Apache::lonxml::curdepth.'">'.
    &HTML::Entities::encode($data,'<>&"').'</textarea>'.
    ($usehtmlarea?&Apache::lonhtmlcommon::spelllink('lonhomework',
    'homework_edit_'.$Apache::lonxml::curdepth):'')."\n";
 }  }
   
 sub modifiedfield {  sub modifiedfield {
   my ($token) = @_;      my ($endtag,$parser) = @_;
   my $result;      my $result;
 #  foreach my $envkey (sort keys %ENV) {  #  foreach my $envkey (sort keys %env) {
 #    &Apache::lonxml::debug("$envkey ---- $ENV{$envkey}");  #    &Apache::lonxml::debug("$envkey ---- $env{$envkey}");
 #  }  #  }
 #  &Apache::lonxml::debug("I want homework_edit_$Apache::lonxml::curdepth");  #  &Apache::lonxml::debug("I want homework_edit_$Apache::lonxml::curdepth");
 #  &Apache::lonxml::debug($ENV{"form.homework_edit_$Apache::lonxml::curdepth"});  #  &Apache::lonxml::debug($env{"form.homework_edit_$Apache::lonxml::curdepth"});
   $result=$ENV{"form.homework_edit_$Apache::lonxml::curdepth"};      $result=$env{"form.homework_edit_$Apache::lonxml::curdepth"};
   return $result;      my $bodytext=&Apache::lonxml::get_all_text($endtag,$parser);
       # textareas throw away intial \n 
       if ($bodytext=~/^\n/) { $result="\n".$result; }
       return $result;
 }  }
   
 # Returns a 1 if the token has been modified and you should rebuild the tag  # Returns a 1 if the token has been modified and you should rebuild the tag
Line 461  sub get_new_args { Line 571  sub get_new_args {
     my ($token,$parstack,$safeeval,@args)=@_;      my ($token,$parstack,$safeeval,@args)=@_;
     my $rebuild=0;      my $rebuild=0;
     foreach my $arg (@args) {      foreach my $arg (@args) {
     #just want the string that it was set to   #just want the string that it was set to
     my $value=$token->[2]->{$arg};   my $value=$token->[2]->{$arg};
     my $element=&html_element_name($arg);   my $element=&html_element_name($arg);
     my $newvalue=$ENV{"form.$element"};   my $newvalue=$env{"form.$element"};
     &Apache::lonxml::debug(" for:$arg: cur is :$value: new is :$newvalue:");   &Apache::lonxml::debug("for:$arg: cur is :$value: new is :$newvalue:");
     if (defined($newvalue) && $value ne $newvalue) {   if (defined($newvalue) && $value ne $newvalue) {
  if (ref($newvalue) eq 'ARRAY') {      if (ref($newvalue) eq 'ARRAY') {
     $token->[2]->{$arg}=join(',',@$newvalue);   $token->[2]->{$arg}=join(',',@$newvalue);
  } else {      } else {
     $token->[2]->{$arg}=$newvalue;   $token->[2]->{$arg}=$newvalue;
       }
       $rebuild=1;
    } elsif (!defined($newvalue) && defined($value)) {
       delete($token->[2]->{$arg});
       $rebuild=1;
  }   }
  $rebuild=1;  
     }      }
   }      return $rebuild;
   return $rebuild;  
 }  }
   
 # looks for /> on start tags  # looks for /> on start tags
 sub rebuild_tag {  sub rebuild_tag {
   my ($token) = @_;      my ($token) = @_;
   my $result;      my $result;
   if ($token->[0] eq 'S') {      if ($token->[0] eq 'S') {
     $result = '<'.$token->[1];   $result = '<'.$token->[1];
     while (my ($key,$val)= each(%{$token->[2]})) {   while (my ($key,$val)= each(%{$token->[2]})) {
       $val=~s:^\s+|\s+$::g;      $val=~s:^\s+|\s+$::g;
       $val=~s:"::g; #"      $val=~s:"::g; #"
       &Apache::lonxml::debug("setting :$key: to  :$val:");      &Apache::lonxml::debug("setting :$key: to  :$val:");
       $result.=' '.$key.'="'.$val.'"';      $result.=' '.$key.'="'.$val.'"';
     }   }
     if ($token->[4] =~ m:/>$:) {   if ($token->[4] =~ m:/>$:) {
       $result.=' />';      $result.=' />';
     } else {   } else {
       $result.='>';      $result.='>';
    }
       } elsif ( $token->[0] eq 'E' ) {
    $result = '</'.$token->[1].'>';
     }      }
   } elsif ( $token->[0] eq 'E' ) {      return $result;
     $result = '</'.$token->[1].'>';  
   }  
   return $result;  
 }  }
   
 sub html_element_name {  sub html_element_name {
Line 520  sub checked_arg { Line 633  sub checked_arg {
     my $result;      my $result;
     my $optionlist="";      my $optionlist="";
     my $allselected=$token->[2]{$name};      my $allselected=$token->[2]{$name};
     $result=$description;      $result=&mt($description);
     foreach my $option (@$list) {      foreach my $option (@$list) {
  my ($value,$text);   my ($value,$text);
  if ( ref($option) eq 'ARRAY') {   if ( ref($option) eq 'ARRAY') {
Line 534  sub checked_arg { Line 647  sub checked_arg {
  $result.="<nobr><input type='checkbox' $value name='".   $result.="<nobr><input type='checkbox' $value name='".
     &html_element_name($name)."'";      &html_element_name($name)."'";
  foreach my $selected (split(/,/,$allselected)) {   foreach my $selected (split(/,/,$allselected)) {
     &Apache::lonxml::error("wha $selected $option<br />");  
     if ( $selected eq $option ) {      if ( $selected eq $option ) {
  $result.=" checked='on' ";   $result.=" checked='checked' ";
  last;   last;
     }      }
  }   }
Line 546  sub checked_arg { Line 658  sub checked_arg {
 }  }
   
 sub text_arg {  sub text_arg {
   my ($description,$name,$token,$size) = @_;      my ($description,$name,$token,$size) = @_;
   my $result;      my $result;
   if (!defined $size) { $size=20; }      if (!defined $size) { $size=20; }
   my $arg=$token->[2]{$name};      my $arg=$token->[2]{$name};
   $result=$description.'&nbsp;<input name="'.&html_element_name($name).      $result=&mt($description).'&nbsp;<input name="'.&html_element_name($name).
     '" type="text" value="'.$arg.'" size="'.$size.'" />';   '" type="text" value="'.$arg.'" size="'.$size.'" />';
   return '<nobr>'.$result.'</nobr>';      return '<nobr>'.$result.'</nobr>';
 }  }
   
 sub select_arg {  sub select_arg {
Line 563  sub select_arg { Line 675  sub select_arg {
     foreach my $option (@$list) {      foreach my $option (@$list) {
  my ($text,$value);   my ($text,$value);
  if ( ref($option) eq 'ARRAY') {   if ( ref($option) eq 'ARRAY') {
     $value='value="'.$$option[0].'"';      $value='value="'.&HTML::Entities::encode($$option[0]).'"';
     $text=$$option[1];      $text=$$option[1];
     $option=$$option[0];      $option=$$option[0];
  } else {   } else {
     $text=$option;      $text=$option;
     $value='value="'.$option.'"';      $value='value="'.&HTML::Entities::encode($option,'\'"&<>').'"';
  }   }
  if ( $selected eq $option ) {   if ( $selected eq $option ) {
     $optionlist.="<option $value selected=\"on\">$text</option>\n";      $optionlist.="<option $value selected=\"selected\">$text</option>\n";
  } else {   } else {
     $optionlist.="<option $value >$text</option>\n";      $optionlist.="<option $value >$text</option>\n";
  }   }
Line 592  sub select_or_text_arg { Line 704  sub select_or_text_arg {
     foreach my $option (@$list) {      foreach my $option (@$list) {
  my ($text,$value);   my ($text,$value);
  if ( ref($option) eq 'ARRAY') {   if ( ref($option) eq 'ARRAY') {
     $value='value="'.$$option[0].'"';      $value='value="'.&HTML::Entities::encode($$option[0]).'"';
     $text=$$option[1];      $text=$$option[1];
     $option=$$option[0];      $option=$$option[0];
  } else {   } else {
     $text=$option;      $text=$option;
     $value='value="'.$option.'"';      $value='value="'.&HTML::Entities::encode($option,'\'"&<>').'"';
  }   }
  if ( $selected eq $option ) {   if ( $selected eq $option ) {
     $optionlist.="<option $value selected=\"on\">$text</option>\n";      $optionlist.="<option $value selected=\"selected\">$text</option>\n";
     $found=1;      $found=1;
  } else {   } else {
     $optionlist.="<option $value>$text</option>\n";      $optionlist.="<option $value>$text</option>\n";
  }   }
     }      }
     $optionlist.="<option value=\"TYPEDINVALUE\">Type in value</option>\n";      $optionlist.="<option value=\"TYPEDINVALUE\"".
     if (($found) || (!$selected)) {    ((!$found)?' selected="selected"':'').
  $result.=$description.'&nbsp;<select name="'.&html_element_name($name)    ">".&mt('Type-in value')."</option>\n";
             .'">  #
        '.$optionlist.'      my $element=&html_element_name($name);
       </select>';      my $selectelement='select_list_'.$element;
     } else {      my $typeinelement='type_in_'.$element;
  $result.=&text_arg($description,$name,$token,$size);      my $typeinvalue=($found?'':$selected);
     }  #
     return '<nobr>'.$result.'</nobr>';      my $hiddenvalue='this.form.'.$element.'.value';
       my $selectedindex='this.form.'.$selectelement.'.selectedIndex';
       my $selectedvalue='this.form.'.$selectelement.
        '.options['.$selectedindex.'].value';
       my $typedinvalue='this.form.'.$typeinelement.'.value';
       my $selecttypeinindex='this.form.'.$selectelement.'.options.length';
       $description=&mt($description);
   #
       return (<<ENDSELECTORTYPE);
   <nobr>
   $description
   &nbsp;<select name="$selectelement"
   onChange="if ($selectedvalue!='TYPEDINVALUE') { $hiddenvalue=$selectedvalue; $typedinvalue=''; }" >
   $optionlist
   </select>
   <input type="text" size="$size" name="$typeinelement"
          value="$typeinvalue" 
   onChange="$hiddenvalue=$typedinvalue;"
   onFocus="$selectedindex=$selecttypeinindex-1;" />
   <input type="hidden" name="$element" value="$selected" />
   </nobr>
   ENDSELECTORTYPE
 }  }
   
 #----------------------------------------------------- image coordinates  #----------------------------------------------------- image coordinates
 # single image coordinates, x, y   # single image coordinates, x, y 
 sub entercoords {  sub entercoords {
     my ($idx,,$idy,$mode,$width,$height) = @_;      my ($idx,$idy,$mode,$width,$height) = @_;
     unless ($Apache::edit::bgimgsrc) { return ''; }      unless ($Apache::edit::bgimgsrc) { return ''; }
     if ($idx) { $idx.='_'; }      if ($idx) { $idx.='_'; }
     if ($idy) { $idy.='_'; }      if ($idy) { $idy.='_'; }
     my $bgfile=&Apache::lonnet::escape($Apache::edit::bgimgsrc);      my $bgfile=&Apache::lonnet::escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc));
     my $form    = 'lonhomework';      my $form    = 'lonhomework';
     my $element;      my $element;
     if (! defined($mode) || $mode eq 'attribute') {      if (! defined($mode) || $mode eq 'attribute') {
Line 634  sub entercoords { Line 767  sub entercoords {
         $element = &Apache::lonnet::escape('homework_edit_'.          $element = &Apache::lonnet::escape('homework_edit_'.
                                            $Apache::lonxml::curdepth);                                             $Apache::lonxml::curdepth);
     }      }
     my $formheight='';      my $id=$Apache::lonxml::curdepth;
       my %data=("imagechoice.$id.type"      =>'point',
         "imagechoice.$id.formname"  =>$form,
         "imagechoice.$id.formx"     =>"$idx$element",
         "imagechoice.$id.formy"     =>"$idy$element",
         "imagechoice.$id.file"      =>$bgfile,
         "imagechoice.$id.formcoord" =>$element);
     if ($height) {      if ($height) {
  $formheight='&formheight='.$height.'_'.$Apache::edit::bgimgsrccurdepth;   $data{"imagechoice.$id.formheight"}=$height.'_'.
       $Apache::edit::bgimgsrccurdepth;
     }      }
     my $formwidth='';  
     if ($width) {      if ($width) {
  $formwidth='&formwidth='.$width.'_'.$Apache::edit::bgimgsrccurdepth;   $data{"imagechoice.$id.formwidth"}=$width.'_'.
       $Apache::edit::bgimgsrccurdepth;
     }      }
     my $result = <<"ENDBUTTON";      &Apache::lonnet::appenv(%data);
 <a href="/cgi-bin/imagechoice.pl?formname=$form&file=$bgfile&formx=$idx$element&formy=$idy$element$formheight$formwidth"      my $text="Click Coordinates";
 target="imagechoice">Click Coordinates</a>      my $result='<a href="/adm/imagechoice?token='.$id.'" target="imagechoice">'.$text.'</a>';
 ENDBUTTON  
     return $result;      return $result;
 }  }
   
 # coordinate pair (x1,y1)-(x2,y2)  # coordinates (x1,y1)-(x2,y2)...
 sub entercoordpair {  # mode can be either box, or polygon
     my ($id,$mode,$width,$height) = @_;  sub entercoord {
       my ($idx,$mode,$width,$height,$type) = @_;
     unless ($Apache::edit::bgimgsrc) { return ''; }      unless ($Apache::edit::bgimgsrc) { return ''; }
     my $bgfile=&Apache::lonnet::escape($Apache::edit::bgimgsrc);      my $bgfile=&Apache::lonnet::escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc));
     my $form    = 'lonhomework';      my $form    = 'lonhomework';
     my $element;      my $element;
     if (! defined($mode) || $mode eq 'attribute') {      if (! defined($mode) || $mode eq 'attribute') {
         $element = &Apache::lonnet::escape("$id\_$Apache::lonxml::curdepth");          $element = &Apache::lonnet::escape("$idx\_$Apache::lonxml::curdepth");
     } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>      } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
         $element = &Apache::lonnet::escape('homework_edit_'.          $element = &Apache::lonnet::escape('homework_edit_'.
                                            $Apache::lonxml::curdepth);                                             $Apache::lonxml::curdepth);
     }      }
     my $formheight='';      my $id=$Apache::lonxml::curdepth;
       my %data=("imagechoice.$id.type"      =>$type,
         "imagechoice.$id.formname"  =>$form,
         "imagechoice.$id.file"      =>$bgfile,
         "imagechoice.$id.formcoord" =>$element);
     if ($height) {      if ($height) {
  $formheight='&formheight='.$height.'_'.$Apache::edit::bgimgsrccurdepth;   $data{"imagechoice.$id.formheight"}=$height.'_'.
       $Apache::edit::bgimgsrccurdepth;
     }      }
     my $formwidth='';  
     if ($width) {      if ($width) {
  $formwidth='&formwidth='.$width.'_'.$Apache::edit::bgimgsrccurdepth;   $data{"imagechoice.$id.formwidth"}=$width.'_'.
       $Apache::edit::bgimgsrccurdepth;
     }      }
     my $result = <<"ENDBUTTON";      &Apache::lonnet::appenv(%data);
 <a href="/cgi-bin/imagechoice.pl?mode=pair&formname=$form&file=$bgfile$formheight$formwidth&formcoord=$element"      my $text="Enter Coordinates";
 target="imagechoice">Click Coordinate Pair</a>      if ($type eq 'polygon') { $text='Create Polygon Data'; }
 ENDBUTTON      my $result='<a href="/adm/imagechoice?token='.$id.'" target="imagechoice">'.$text.'</a>';
     return $result;      return $result;
 }  }
   
   sub deletecoorddata {
       &Apache::lonnet::delenv("imagechoice\\.");
   }
   
 #----------------------------------------------------- browse  #----------------------------------------------------- browse
 sub browse {  sub browse {
     # insert a link to call up the filesystem browser (lonindexer)      # insert a link to call up the filesystem browser (lonindexer)
     my ($id, $mode) = @_;      my ($id, $mode, $titleid) = @_;
     my $form    = 'lonhomework';      my $form    = 'lonhomework';
     my $element;      my $element;
     if (! defined($mode) || $mode eq 'attribute') {      if (! defined($mode) || $mode eq 'attribute') {
         $element = &Apache::lonnet::escape("$id\_$Apache::lonxml::curdepth");          $element = &Apache::lonnet::escape("$id\_$Apache::lonxml::curdepth");
     } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>      } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
         $element = &Apache::lonnet::escape('homework_edit_'.          $element = &Apache::lonnet::escape('homework_edit_'.
                                            $Apache::lonxml::curdepth);                                             $Apache::lonxml::curdepth);
       }
       my $titleelement;
       if ($titleid) {
    $titleelement=",'','','".&Apache::lonnet::escape("$titleid\_$Apache::lonxml::curdepth")."'";
     }      }
     my $result = <<"ENDBUTTON";      my $result = <<"ENDBUTTON";
 <a href=\"javascript:openbrowser('$form','$element')\"\>Select</a>  <a href=\"javascript:openbrowser('$form','$element'$titleelement)\"\>Select</a>
 ENDBUTTON  ENDBUTTON
     return $result;      return $result;
 }  }
Line 697  ENDBUTTON Line 851  ENDBUTTON
 #----------------------------------------------------- browse  #----------------------------------------------------- browse
 sub search {  sub search {
     # insert a link to call up the filesystem browser (lonindexer)      # insert a link to call up the filesystem browser (lonindexer)
     my ($id, $mode) = @_;      my ($id, $mode, $titleid) = @_;
     my $form    = 'lonhomework';      my $form    = 'lonhomework';
     my $element;      my $element;
     if (! defined($mode) || $mode eq 'attribute') {      if (! defined($mode) || $mode eq 'attribute') {
Line 706  sub search { Line 860  sub search {
         $element = &Apache::lonnet::escape('homework_edit_'.          $element = &Apache::lonnet::escape('homework_edit_'.
                                            $Apache::lonxml::curdepth);                                             $Apache::lonxml::curdepth);
     }      }
       my $titleelement;
       if ($titleid) {
    $titleelement=",'".&Apache::lonnet::escape("$titleid\_$Apache::lonxml::curdepth")."'";
       }
     my $result = <<"ENDBUTTON";      my $result = <<"ENDBUTTON";
 <a href=\"javascript:opensearcher('$form','$element')\"\>Search</a>  <a href=\"javascript:opensearcher('$form','$element'$titleelement)\"\>Search</a>
 ENDBUTTON  ENDBUTTON
     return $result;      return $result;
 }  }

Removed from v.1.57.2.3  
changed lines
  Added in v.1.96


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.