File:  [LON-CAPA] / loncom / homework / edit.pm
Revision 1.21: download - view: text, annotated - select for diffs
Mon Aug 13 21:43:48 2001 UTC (22 years, 10 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- added tag creation routines

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

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