Diff for /loncom/homework/edit.pm between versions 1.28 and 1.90

version 1.28, 2002/01/21 16:40:57 version 1.90, 2005/03/10 02:33:30
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 3/20 Guy  
 # 01/10/02 Matthew  
 package Apache::edit;   package Apache::edit; 
   
 use strict;  use strict;
 use Apache::lonnet;  use Apache::lonnet();
   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
 @Apache::edit::colorlist=('#ffffff','#ff0000','#00ff00','#0000ff','#0ff000','#000ff0','#f0000f');  @Apache::edit::colorlist=('#ffffff','#ff0000','#00ff00','#0000ff','#0ff000','#000ff0','#f0000f');
 # depth of nesting of edit  # depth of nesting of edit
 $Apache::edit::colordepth=0;  $Apache::edit::colordepth=0;
   @Apache::edit::inserttag=();
   # image-type responses: active background image and curdepth at definition
   $Apache::edit::bgimgsrc='';
   $Apache::edit::bgimgsrccurdepth='';
   
 sub initialize_edit {  sub initialize_edit {
   $Apache::edit::colordepth=0;      $Apache::edit::colordepth=0;
       @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') {
     my $tag=$token->[1];   $result.="</td></tr>".&end_table()."\n";
     if (!defined($description)) {  
       $result.="</td></tr><tr><td>&lt;/$tag&gt;</td><td colspan=\"2\">&nbsp;</td>";  
     } else {  
       if ($description ne '') { $result.="</td></tr><tr><td>$description</td><td colspan=\"2\">&nbsp;</td>"; }  
     }      }
     $result.="</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; }   if (defined($tagnum)) { last; }
   }      }
   if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }      if (!defined ($tagnum)) {$tagnum=$Apache::lonxml::insertlist{"$tag.num"};}
   my $color = $Apache::lonxml::insertlist{"$tagnum.color"};      my $color = $Apache::lonxml::insertlist{"$tagnum.color"};
   if (!defined($color)) {      if (!defined($color)) {
     $color = $Apache::edit::colorlist[$Apache::edit::colordepth];   $color = $Apache::edit::colorlist[$Apache::edit::colordepth];
   }      }
   $Apache::edit::colordepth++;      $Apache::edit::colordepth++;
   my $result="<table bgcolor=\"$color\" width=\"100%\" border=\"5\">";      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>";      my $result='</table></div>';
   return $result;      $result.="<table><tr><td>";
   
       my ($tagname,$closingtag);
       if (defined($Apache::edit::inserttag[-2])) {
    $tagname=$Apache::edit::inserttag[-2];
       } else {$tagname='problem';}
       if (defined($Apache::edit::inserttag[-1])) {
    $closingtag=$Apache::edit::inserttag[-1];
       }
       $result.=&innerinsertlist('edit',$tagname,$closingtag).
    "</td></tr></table>";
       pop(@Apache::edit::inserttag);
       return $result;
 }  }
   
 sub start_spanning_row { return '<tr><td colspan="3">';}  sub start_spanning_row { return '<tr><td colspan="4" bgcolor="#DDDDDD">';}
 sub start_row          { return '<tr><td>';            }  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[$#$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 ($token) = @_;      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{"$token->[1].which"}) {      if ($Apache::lonxml::insertlist{"$tagname.which"}) {
     push (@tagnums, @{ $Apache::lonxml::insertlist{"$token->[1].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".'::'."$token->[1].which"}) {   if ($Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"}) {
       push (@tagnums, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$token->[1].which"} });      push (@tagnums, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"} });
     }   }
   }      }
   if (@tagnums) {      if (@tagnums) {
     foreach my $tagnum (@tagnums) {   my %options;
       $result.='<option value="'.$tagnum.'">'.$Apache::lonxml::insertlist{"$tagnum.description"}."</option>\n";   foreach my $tagnum (@tagnums) {
     }      my $descrip=$Apache::lonxml::insertlist{"$tagnum.description"};
     if ($result) { $result='<option selected="on"></option>'.$result; }      $options{$descrip} ="<option value=\"$tagnum\">".
   }   $descrip."</option>\n";
   return $result;   }
    foreach my $option (sort(keys(%options))) {$result.=$options{$option};}
    if ($result) { $result='<option selected="selected"></option>'.$result; }
       }
       return $result;
 }  }
   
 sub insertlist {  sub insertlist {
   my ($target,$token) = @_;      my ($target,$token) = @_;
   my $result;      return &innerinsertlist($target,$token->[1]);
   if ($target eq 'edit') {  }
     my $optionlist= &get_insert_list($token);  
     if ($optionlist) {  sub innerinsertlist {
       $result = "Insert:      my ($target,$tagname,$closingtag) = @_;
 <select name=\"insert_$Apache::lonxml::curdepth\">      my $result;
 $optionlist      my $after='';
 </select>"      if ($closingtag) {
     } else {   $after='_after_'.$closingtag; 
       $result="&nbsp;";      }
       if ($target eq 'edit') {
    my $optionlist= &get_insert_list($tagname);
    if ($optionlist) {
       $result = "Insert:
               <select name=\"insert$after\_$Apache::lonxml::curdepth\">
                     $optionlist
               </select>"
    } else {
       $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();
   return $result;      }
    } else {
       my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
       &Apache::lonxml::error("Unable to insert tag $newtag, $func was not defined.");
    }
       }
       return $result;
   }
   
   sub handle_insertafter {
       my $tagname=shift;
       if ($ENV{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"} eq '')
       { return ''; }
       my $result;
       my $tagnum =$ENV{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"};
       my $func=$Apache::lonxml::insertlist{"$tagnum.function"};
       if ($func eq 'default') {
    my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
    my $namespace;
    if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
    $result.="\n<$newtag>\n</$newtag>";
       } else {
    if (defined(&$func)) {
       {
    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;
   }
   
   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_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 {
       return '
   <essayresponse>
       <textfield></textfield>
   </essayresponse>';
   }
   
   sub insert_imageresponse {
       return '
   <imageresponse max="1">
       <foilgroup>
         <foil>
         </foil>
       </foilgroup>
       <hintgroup>
       <startouttext /><endouttext />
       </hintgroup>
   </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 {
       return '
   <rankresponse max="10">
       <foilgroup options="">
         <foil>
            <startouttext /><endouttext />
         </foil>
       </foilgroup>
       <hintgroup>
       <startouttext /><endouttext />
       </hintgroup>
   </rankresponse>';
   }
   
   sub insert_matchresponse {
       return '
   <matchresponse max="10">
       <foilgroup options="">
         <itemgroup>
         </itemgroup>
         <foil>
            <startouttext /><endouttext />
         </foil>
       </foilgroup>
       <hintgroup>
       <startouttext /><endouttext />
       </hintgroup>
   </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 {
       return '
   <stringhint>
   </stringhint>';
   }
   
   sub insert_formulahint {
       return '
   <formulahint>
   </formulahint>';
   }
   
   sub insert_radiobuttonhint {
       return '
   <radiobuttonhint>
   </radiobuttonhint>';
   }
   
   sub insert_optionhint {
       return '
   <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)) { $count++;      foreach (split ("\n", $$data)) {
    $count+=int(length($_)/79);
    $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 {
       my ($tag,$data,$description,$size)=@_;
       $data=&HTML::Entities::encode($data,'<>&"');
       if ($description) { $description="<br />".$description."<br />"; }
       my $result = <<"END";
   $description
   <input type="text" name="homework_edit_$Apache::lonxml::curdepth" 
          value="$data" size="$size" />
   END
       return $result;
 }  }
   
 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."\">$data</textarea>\n";      }
       if ($cols > 80) { $cols = 80; }
       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 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
 # side-effects, will modify the $token if new values are found  # side-effects, will modify the $token if new values are found
 sub get_new_args {  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 $newvalue=$ENV{"form.$Apache::lonxml::curdepth.$arg"};   my $element=&html_element_name($arg);
     &Apache::lonxml::debug(" for:$arg: cur is :$value: new is :$newvalue:");   my $newvalue=$ENV{"form.$element"};
     if ($value ne $newvalue) {   &Apache::lonxml::debug("for:$arg: cur is :$value: new is :$newvalue:");
       $token->[2]->{$arg}=$newvalue;   if (defined($newvalue) && $value ne $newvalue) {
       $rebuild=1;      if (ref($newvalue) eq 'ARRAY') {
    $token->[2]->{$arg}=join(',',@$newvalue);
       } else {
    $token->[2]->{$arg}=$newvalue;
       }
       $rebuild=1;
    } elsif (!defined($newvalue) && defined($value)) {
       delete($token->[2]->{$arg});
       $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:/>$:) {
       $result.=' />';
    } else {
       $result.='>';
    }
       } elsif ( $token->[0] eq 'E' ) {
    $result = '</'.$token->[1].'>';
       }
       return $result;
   }
   
   sub html_element_name {
       my ($name) = @_;
       return $name.'_'.$Apache::lonxml::curdepth;
   }
   
   sub hidden_arg {
       my ($name,$token) = @_;
       my $result;
       my $arg=$token->[2]{$name};
       $result='<input name="'.&html_element_name($name).
    '" type="hidden" value="'.$arg.'" />';
       return $result;
   }
   
   sub checked_arg {
       my ($description,$name,$list,$token) = @_;
       my $result;
       my $optionlist="";
       my $allselected=$token->[2]{$name};
       $result=&mt($description);
       foreach my $option (@$list) {
    my ($value,$text);
    if ( ref($option) eq 'ARRAY') {
       $value='value="'.$$option[0].'"';
       $text=$$option[1];
       $option=$$option[0];
    } else {
       $text=$option;
       $value='value="'.$option.'"';
    }
    $result.="<nobr><input type='checkbox' $value name='".
       &html_element_name($name)."'";
    foreach my $selected (split(/,/,$allselected)) {
       if ( $selected eq $option ) {
    $result.=" checked='checked' ";
    last;
       }
    }
    $result.=" />$text</nobr>\n";
     }      }
     if ($token->[4] =~ m:/>$:) {      return $result;
       $result.=' />';  
     } else {  
       $result.='>';  
     }  
   } elsif ( $token->[0] eq 'E' ) {  
     $result = '</'.$token->[1].'>';  
   }  
   return $result;  
 }  }
   
 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.'<input name="'."$Apache::lonxml::curdepth.$name".      $result=&mt($description).'&nbsp;<input name="'.&html_element_name($name).
     '" type="text" value="'.$arg.'" size="'.$size.'" />';   '" type="text" value="'.$arg.'" size="'.$size.'" />';
   return $result;      return '<nobr>'.$result.'</nobr>';
 }  }
   
 sub select_arg {  sub select_arg {
   my ($description,$name,$list,$token) = @_;      my ($description,$name,$list,$token) = @_;
   my $result;      my $result;
   my $optionlist="";      my $optionlist="";
   my $selected=$token->[2]{$name};      my $selected=$token->[2]{$name};
   foreach my $option (@$list) {      foreach my $option (@$list) {
     if ( $selected eq $option ) {   my ($text,$value);
       $optionlist.="<option selected=\"on\">$option</option>\n";   if ( ref($option) eq 'ARRAY') {
     } else {      $value='value="'.$$option[0].'"';
       $optionlist.="<option>$option</option>\n";      $text=$$option[1];
       $option=$$option[0];
    } else {
       $text=$option;
       $value='value="'.$option.'"';
    }
    if ( $selected eq $option ) {
       $optionlist.="<option $value selected=\"selected\">$text</option>\n";
    } else {
       $optionlist.="<option $value >$text</option>\n";
    }
     }      }
   }      $result.='<nobr>'.$description.'&nbsp;<select name="'.
   $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">   &html_element_name($name).'">
        '.$optionlist.'         '.$optionlist.'
       </select>';        </select></nobr>';
   return $result;      return $result;
 }  }
   
 sub select_or_text_arg {  sub select_or_text_arg {
   my ($description,$name,$list,$token,$size) = @_;      my ($description,$name,$list,$token,$size) = @_;
   my $result;      my $result;
   my $optionlist="";      my $optionlist="";
   my $found=0;      my $found=0;
   my $selected=$token->[2]{$name};      my $selected=$token->[2]{$name};
   foreach my $option (@$list) {      foreach my $option (@$list) {
     if ( $selected eq $option ) {   my ($text,$value);
       $optionlist.="<option selected=\"on\">$option</option>\n";   if ( ref($option) eq 'ARRAY') {
       $found=1;      $value='value="'.$$option[0].'"';
     } else {      $text=$$option[1];
       $optionlist.="<option>$option</option>\n";      $option=$$option[0];
     }   } else {
   }      $text=$option;
   $optionlist.="<option value=\"TYPEDINVALUE\">Type in value</option>\n";      $value='value="'.$option.'"';
   if ($found) {   }
     $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">   if ( $selected eq $option ) {
        '.$optionlist.'      $optionlist.="<option $value selected=\"selected\">$text</option>\n";
       </select>';      $found=1;
   } else {   } else {
     $result.=&text_arg($description,$name,$token,$size);      $optionlist.="<option $value>$text</option>\n";
   }   }
   return $result;      }
       $optionlist.="<option value=\"TYPEDINVALUE\"".
     ((!$found)?' selected="selected"':'').
     ">".&mt('Type-in value')."</option>\n";
   #
       my $element=&html_element_name($name);
       my $selectelement='select_list_'.$element;
       my $typeinelement='type_in_'.$element;
       my $typeinvalue=($found?'':$selected);
   #
       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
   # single image coordinates, x, y 
   sub entercoords {
       my ($idx,$idy,$mode,$width,$height) = @_;
       unless ($Apache::edit::bgimgsrc) { return ''; }
       if ($idx) { $idx.='_'; }
       if ($idy) { $idy.='_'; }
       my $bgfile=&Apache::lonnet::escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc));
       my $form    = 'lonhomework';
       my $element;
       if (! defined($mode) || $mode eq 'attribute') {
           $element = &Apache::lonnet::escape("$Apache::lonxml::curdepth");
       } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
           $element = &Apache::lonnet::escape('homework_edit_'.
                                              $Apache::lonxml::curdepth);
       }
       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) {
    $data{"imagechoice.$id.formheight"}=$height.'_'.
       $Apache::edit::bgimgsrccurdepth;
       }
       if ($width) {
    $data{"imagechoice.$id.formwidth"}=$width.'_'.
       $Apache::edit::bgimgsrccurdepth;
       }
       &Apache::lonnet::appenv(%data);
       my $text="Click Coordinates";
       my $result='<a href="/adm/imagechoice?token='.$id.'" target="imagechoice">'.$text.'</a>';
       return $result;
   }
   
   # coordinates (x1,y1)-(x2,y2)...
   # mode can be either box, or polygon
   sub entercoord {
       my ($idx,$mode,$width,$height,$type) = @_;
       unless ($Apache::edit::bgimgsrc) { return ''; }
       my $bgfile=&Apache::lonnet::escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc));
       my $form    = 'lonhomework';
       my $element;
       if (! defined($mode) || $mode eq 'attribute') {
           $element = &Apache::lonnet::escape("$idx\_$Apache::lonxml::curdepth");
       } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
           $element = &Apache::lonnet::escape('homework_edit_'.
                                              $Apache::lonxml::curdepth);
       }
       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) {
    $data{"imagechoice.$id.formheight"}=$height.'_'.
       $Apache::edit::bgimgsrccurdepth;
       }
       if ($width) {
    $data{"imagechoice.$id.formwidth"}=$width.'_'.
       $Apache::edit::bgimgsrccurdepth;
       }
       &Apache::lonnet::appenv(%data);
       my $text="Enter Coordinates";
       if ($type eq 'polygon') { $text='Create Polygon Data'; }
       my $result='<a href="/adm/imagechoice?token='.$id.'" target="imagechoice">'.$text.'</a>';
       return $result;
   }
   
   sub deletecoorddata {
       &Apache::lonnet::delenv("imagechoice\\.");
   }
   
   #----------------------------------------------------- browse
   sub browse {
       # insert a link to call up the filesystem browser (lonindexer)
       my ($id, $mode, $titleid) = @_;
       my $form    = 'lonhomework';
       my $element;
       if (! defined($mode) || $mode eq 'attribute') {
           $element = &Apache::lonnet::escape("$id\_$Apache::lonxml::curdepth");
       } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
           $element = &Apache::lonnet::escape('homework_edit_'.
                                              $Apache::lonxml::curdepth);
       }
       my $titleelement;
       if ($titleid) {
    $titleelement=",'','','".&Apache::lonnet::escape("$titleid\_$Apache::lonxml::curdepth")."'";
       }
       my $result = <<"ENDBUTTON";
   <a href=\"javascript:openbrowser('$form','$element'$titleelement)\"\>Select</a>
   ENDBUTTON
       return $result;
   }
   
   #----------------------------------------------------- browse
   sub search {
       # insert a link to call up the filesystem browser (lonindexer)
       my ($id, $mode, $titleid) = @_;
       my $form    = 'lonhomework';
       my $element;
       if (! defined($mode) || $mode eq 'attribute') {
           $element = &Apache::lonnet::escape("$id\_$Apache::lonxml::curdepth");
       } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
           $element = &Apache::lonnet::escape('homework_edit_'.
                                              $Apache::lonxml::curdepth);
       }
       my $titleelement;
       if ($titleid) {
    $titleelement=",'".&Apache::lonnet::escape("$titleid\_$Apache::lonxml::curdepth")."'";
       }
       my $result = <<"ENDBUTTON";
   <a href=\"javascript:opensearcher('$form','$element'$titleelement)\"\>Search</a>
   ENDBUTTON
       return $result;
 }  }
   
   
 1;  1;
 __END__  __END__
   
Line 515  from lonxml; return a scalar string Line 949  from lonxml; return a scalar string
 get_insert_list($token) : provide an insertion list based on possibilities  get_insert_list($token) : provide an insertion list based on possibilities
 from lonxml; return a scalar string  from lonxml; return a scalar string
   
   =item *
   browse($elementname) : provide a link which will open up the filesystem
   browser (lonindexer) and, once a file is selected, place the result in
   the form element $elementname.
   
   =item *
   search($elementname) : provide a link which will open up the filesystem
   searcher (lonsearchcat) and, once a file is selected, place the result in
   the form element $elementname.
   
   =item *
   editline(tag,data,description,size): Provide a <input type="text" ../> for
   single-line text entry.  This is to be used for text enclosed by tags, not
   arguements/parameters associated with a tag.
   
 =back  =back
   
 incomplete...  incomplete...

Removed from v.1.28  
changed lines
  Added in v.1.90


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.