Return to edit.pm CVS log

Up to [LON-CAPA] / loncom / homework

- better support for getting descrtiptions

    1: # The LearningOnline Network with CAPA 
    2: # edit mode helpers
    3: # 3/20 Guy
    4: package Apache::edit; 
    5: 
    6: use strict;
    7: use Apache::lonnet;
    8: 
    9: # Global Vars
   10: # default list of colors to use in editing
   11: @Apache::edit::colorlist=('#ffffff','#ff0000','#00ff00','#0000ff','#0ff000','#000ff0','#f0000f');
   12: # depth of nesting of edit
   13: $Apache::edit::colordepth=0;
   14: 
   15: sub initialize_edit {
   16:   $Apache::edit::colordepth=0;
   17: }
   18: 
   19: sub tag_start {
   20:   my ($target,$token,$description) = @_;
   21:   my $result='';
   22:   if ($target eq "edit") {
   23:     my $tag=$token->[1];
   24:     if (!$description) {
   25:       $description=&Apache::lonxml::description($token);
   26:       if (!$description) { $description="<$tag>"; }
   27:     }
   28:     $result.= &start_table($token)."<tr><td>$description</td>
   29: <td>Delete".
   30:   &deletelist($target,$token)
   31:   ."</td>
   32: <td>".
   33:   &insertlist($target,$token).
   34:     "</td>
   35: </tr><tr><td colspan=\"3\">\n";
   36: #<td>".
   37: #  &movebuttons($target,$token).
   38: #    "</tr><tr><td colspan=\"3\">\n";
   39:   }
   40:   return $result;
   41: }
   42: 
   43: sub tag_end {
   44:   my ($target,$token,$description) = @_;
   45:   my $result='';
   46:   if ($target eq 'edit') {
   47:     my $tag=$token->[1];
   48:     if (!defined($description)) {
   49:       $result.="</td></tr><tr><td>&lt;/$tag&gt;</td><td colspan=\"2\">&nbsp;</td>";
   50:     } else {
   51:       if ($description ne '') { $result.="</td></tr><tr><td>$description</td><td colspan=\"2\">&nbsp;</td>"; }
   52:     }
   53:     $result.="</tr>".&end_table()."\n";
   54:   }
   55:   return $result;
   56: }
   57: 
   58: sub start_table {
   59:   my ($token)=@_;
   60:   my $tag = $token->[1];
   61:   my $tagnum;
   62:   foreach my $namespace (reverse @Apache::lonxml::namespace) {
   63:     my $testtag=$namespace.'::'.$tag;
   64:     $tagnum=$Apache::lonxml::insertlist{"$testtag.num"};
   65:     if (defined($tagnum)) { last; }
   66:   }
   67:   if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
   68:   my $color = $Apache::lonxml::insertlist{"$tagnum.color"};
   69:   if (!defined($color)) {
   70:     $color = $Apache::edit::colorlist[$Apache::edit::colordepth];
   71:   }
   72:   $Apache::edit::colordepth++;
   73:   my $result="<table bgcolor=\"$color\" width=\"100%\" border=\"5\">";
   74:   return $result;
   75: }
   76: 
   77: sub end_table {
   78:   $Apache::edit::colordepth--;
   79:   my $result="</table>";
   80:   return $result;
   81: }
   82: 
   83: sub movebuttons {
   84:   my ($target,$token) = @_;
   85:   my $result='<input type="submit" name="moveup.'.
   86:     $Apache::lonxml::curdepth.'" value="Move Up" />';
   87:   $result.='<input type="submit" name="movedown.'.
   88:     $Apache::lonxml::curdepth.'" value="Move Down" />';
   89:   return $result;
   90: }
   91: 
   92: sub deletelist {
   93:   my ($target,$token) = @_;
   94:   my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
   95: <option></option>
   96: <option>Yes</option>
   97: </select>";
   98:   return $result;
   99: }
  100: 
  101: sub handle_delete {
  102:   if (!$ENV{"form.delete_$Apache::lonxml::curdepth"}) { return ''; }
  103:   my ($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  104:   my $result=0;
  105:   if ($space) {
  106:     my $sub1="$space\:\:delete_$token->[1]";
  107:     {
  108:       no strict 'refs';
  109:       if (defined &$sub1) {
  110: 	$result=&$sub1($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  111:       }
  112:     }
  113:   }
  114:   if (!$result) {
  115:     my $endtag='/'.$token->[1];
  116:     my $bodytext=&Apache::lonxml::get_all_text($endtag,$$parser[$#$parser]);
  117:     $$parser['-1']->get_token();
  118:     &Apache::lonxml::debug("Deleting :$bodytext: for $token->[1]");
  119:     &Apache::lonxml::end_tag($tagstack,$parstack,$token);
  120:   }
  121:   return 1;
  122: }
  123: 
  124: sub get_insert_list {
  125:   my ($token) = @_;
  126:   my $result='';
  127:   my @tagnums= ();
  128:   #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
  129:   if ($Apache::lonxml::insertlist{"$token->[1].which"}) {
  130:     push (@tagnums, @{ $Apache::lonxml::insertlist{"$token->[1].which"} });
  131:   }
  132:   foreach my $namespace (@Apache::lonxml::namespace) {
  133:     if ($Apache::lonxml::insertlist{"$namespace".'::'."$token->[1].which"}) {
  134:       push (@tagnums, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$token->[1].which"} });
  135:     }
  136:   }
  137:   if (@tagnums) {
  138:     foreach my $tagnum (@tagnums) {
  139:       $result.='<option value="'.$tagnum.'">'.$Apache::lonxml::insertlist{"$tagnum.description"}."</option>\n";
  140:     }
  141:     if ($result) { $result='<option selected="on"></option>'.$result; }
  142:   }
  143:   return $result;
  144: }
  145: 
  146: sub insertlist {
  147:   my ($target,$token) = @_;
  148:   my $result;
  149:   if ($target eq 'edit') {
  150:     my $optionlist= &get_insert_list($token);
  151:     if ($optionlist) {
  152:       $result = "Insert:
  153: <select name=\"insert_$Apache::lonxml::curdepth\">
  154: $optionlist
  155: </select>"
  156:     } else {
  157:       $result="&nbsp;";
  158:     }
  159:   }
  160:   return $result;
  161: }
  162: 
  163: sub handle_insert {
  164:   if ($ENV{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
  165:   my $result;
  166:   my $tagnum = $ENV{"form.insert_$Apache::lonxml::curdepth"};
  167:   my $func=$Apache::lonxml::insertlist{"$tagnum.function"};
  168:   if ($func eq 'default') {
  169:     my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
  170:     my $namespace;
  171:     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
  172:     $result.="\n<$newtag>\n</$newtag>";
  173:   } else {
  174:     if (defined(&$func)) {
  175:       {
  176: 	no strict 'refs';
  177: 	$result.=&$func();
  178:       }
  179:     } else {
  180:       my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
  181:       &Apache::lonxml::error("Unable to insert tag $newtag, $func was not defined.");
  182:     }
  183:   }
  184:   return $result;
  185: }
  186: 
  187: sub insert_responseparam {
  188:   return '
  189:     <responseparam />';
  190: }
  191: 
  192: sub insert_numericalresponse {
  193:   return '
  194: <numericalresponse answer="">
  195:     <textline />
  196:     <hintgroup>
  197:     </hintgroup>
  198: </numericalresponse>';
  199: }
  200: 
  201: sub insert_stringresponse {
  202:   return '
  203: <stringresponse answer="" type="">
  204:     <textline />
  205:     <hintgroup>
  206:     </hintgroup>
  207: </stringresponse>';
  208: }
  209: 
  210: sub insert_optionresponse {
  211:   return '
  212: <optionresponse max="10">
  213:     <foilgroup options="">
  214:     </foilgroup>
  215:     <hintgroup>
  216:     </hintgroup>
  217: </optionresponse>';
  218: }
  219: 
  220: sub insert_radiobuttonresponse {
  221:   return '
  222: <radiobuttonresponse max="10">
  223:     <foilgroup>
  224:     </foilgroup>
  225:     <hintgroup>
  226:     </hintgroup>
  227: </radiobuttonresponse>';
  228: }
  229: 
  230: sub insert_displayduedate { return '<displayduedate />'; }
  231: sub insert_displaytitle   { return '<displaytitle />'; }
  232: sub insert_hintpart {
  233:   return '
  234: <hintpart on="default">
  235:     <startouttext/>
  236:     <endouttext />
  237: </hintpart>';
  238: }
  239: 
  240: sub insert_numericalhint {
  241:   return '
  242: <numericalhint>
  243: </numericalhint>';
  244: }
  245: 
  246: sub insert_startouttext {
  247:   return "<startouttext />\n<endouttext />";
  248: }
  249: 
  250: sub insert_script {
  251:   return "\n<script type=\"loncapa/perl\">\n</script>";
  252: }
  253: 
  254: sub editfield {
  255:   my ($tag,$data,$description,$minwidth,$minheight)=@_;
  256: 
  257:   my $count=0;
  258:   my $maxlength=-1;
  259:   map { $count++;
  260: 	if (length($_) > $maxlength) { $maxlength = length ($_); }
  261:       } split ("\n", $data);
  262:   if ($maxlength > 80) { $maxlength = 80; }
  263:   if ($maxlength < $minwidth) { $maxlength = $minwidth; }
  264:   if ( $count < $minheight) { $count = $minheight; }
  265:   if ($description) {
  266:     $description="<br />".$description."<br />";
  267:   }
  268:   return "$description\n&nbsp;&nbsp;&nbsp;<textarea rows=\"$count\" cols=\"$maxlength\" name=homework_edit_".$Apache::lonxml::curdepth.">$data</textarea>\n";
  269: #  return "<br />\n&lt;$tag&gt;<br />\n&nbsp;&nbsp;&nbsp;<textarea rows=\"$count\" cols=\"$maxlength\" name=homework_edit_".$Apache::lonxml::curdepth.">$data</textarea><br />\n&lt;/$tag&gt;<br />\n";
  270: }
  271: 
  272: sub modifiedfield {
  273:   my ($token) = @_;
  274:   my $result;
  275: #  foreach my $envkey (sort keys %ENV) {
  276: #    &Apache::lonxml::debug("$envkey ---- $ENV{$envkey}");
  277: #  }
  278: #  &Apache::lonxml::debug("I want homework_edit_$Apache::lonxml::curdepth");
  279: #  &Apache::lonxml::debug($ENV{"form.homework_edit_$Apache::lonxml::curdepth"});
  280:   $result=$ENV{"form.homework_edit_$Apache::lonxml::curdepth"};
  281:   if (defined $token) {
  282:     if (defined $token->[4]) {
  283:       $result=$token->[4].$result;
  284:     } else {
  285:       $result=$result.$token->[2];
  286:     }
  287:   }
  288:   return $result;
  289: }
  290: 
  291: # Returns a 1 if the token has been modified and you should rebuild the tag
  292: # side-effects, will modify the $token if new values are found
  293: sub get_new_args {
  294:   my ($token,$parstack,$safeeval,@args)=@_;
  295:   my $rebuild=0;
  296:   foreach my $arg (@args) {
  297:     #just want the string that it was set to
  298:     my $value=$token->[2]->{$arg};
  299:     my $newvalue=$ENV{"form.$Apache::lonxml::curdepth.$arg"};
  300:     &Apache::lonxml::debug(" for:$arg: cur is :$value: new is :$newvalue:");
  301:     if ($value ne $newvalue) {
  302:       $token->[2]->{$arg}=$newvalue;
  303:       $rebuild=1;
  304:     }
  305:   }
  306:   return $rebuild;
  307: }
  308: 
  309: # looks for /> on start tags
  310: sub rebuild_tag {
  311:   my ($token) = @_;
  312:   my $result;
  313:   if ($token->[0] eq 'S') {
  314:     $result = '<'.$token->[1];
  315:     while (my ($key,$val)= each(%{$token->[2]})) {
  316:       $val=~s:^\s+|\s+$::g;
  317:       $val=~s:"::g; #"
  318:       &Apache::lonxml::debug("setting :$key: to  :$val:");
  319:       $result.=' '.$key.'="'.$val.'"';
  320:     }
  321:     if ($token->[4] =~ m:/>$:) {
  322:       $result.=' />';
  323:     } else {
  324:       $result.='>';
  325:     }
  326:   } elsif ( $token->[0] eq 'E' ) {
  327:     $result = '</'.$token->[1].'>';
  328:   }
  329:   return $result;
  330: }
  331: 
  332: sub text_arg {
  333:   my ($description,$name,$token,$size) = @_;
  334:   my $result;
  335:   if (!defined $size) { $size=20; }
  336:   my $arg=$token->[2]{$name};
  337:   $result=$description.'<input name="'."$Apache::lonxml::curdepth.$name".
  338:     '" type="text" value="'.$arg.'" size="'.$size.'" />';
  339:   return $result;
  340: }
  341: 
  342: sub select_arg {
  343:   my ($description,$name,$list,$token) = @_;
  344:   my $result;
  345:   my $optionlist="";
  346:   my $selected=$token->[2]{$name};
  347:   foreach my $option (@$list) {
  348:     if ( $selected eq $option ) {
  349:       $optionlist.="<option selected=\"on\">$option</option>\n";
  350:     } else {
  351:       $optionlist.="<option>$option</option>\n";
  352:     }
  353:   }
  354:   $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
  355:        '.$optionlist.'
  356:       </select></td></tr><tr><td colspan="3">';
  357:   return $result;
  358: }
  359: 
  360: sub select_or_text_arg {
  361:   my ($description,$name,$list,$token,$size) = @_;
  362:   my $result;
  363:   my $optionlist="";
  364:   my $found=0;
  365:   my $selected=$token->[2]{$name};
  366:   foreach my $option (@$list) {
  367:     if ( $selected eq $option ) {
  368:       $optionlist.="<option selected=\"on\">$option</option>\n";
  369:       $found=1;
  370:     } else {
  371:       $optionlist.="<option>$option</option>\n";
  372:     }
  373:   }
  374:   $optionlist.="<option value=\"TYPEDINVALUE\">Type in value</option>\n";
  375:   if ($found) {
  376:     $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
  377:        '.$optionlist.'
  378:       </select></td></tr><tr><td colspan="3">';
  379:   } else {
  380:     $result.=&text_arg($description,$name,$token,$size);
  381:   }
  382:   return $result;
  383: }
  384: 1;
  385: __END__