Annotation of loncom/homework/edit.pm, revision 1.24

1.1       albertel    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: 
1.10      albertel    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: 
1.1       albertel   19: sub tag_start {
1.9       albertel   20:   my ($target,$token,$description) = @_;
1.1       albertel   21:   my $result='';
1.5       albertel   22:   if ($target eq "edit") {
1.4       albertel   23:     my $tag=$token->[1];
1.22      albertel   24:     if (!$description) {
                     25:       $description=&Apache::lonxml::description($token);
                     26:       if (!$description) { $description="<$tag>"; }
                     27:     }
1.10      albertel   28:     $result.= &start_table($token)."<tr><td>$description</td>
1.14      albertel   29: <td>Delete".
1.8       albertel   30:   &deletelist($target,$token)
                     31:   ."</td>
1.4       albertel   32: <td>".
1.8       albertel   33:   &insertlist($target,$token).
1.4       albertel   34:     "</td>
1.1       albertel   35: </tr><tr><td colspan=\"3\">\n";
1.22      albertel   36: #<td>".
                     37: #  &movebuttons($target,$token).
                     38: #    "</tr><tr><td colspan=\"3\">\n";
1.4       albertel   39:   }
1.1       albertel   40:   return $result;
                     41: }
                     42: 
                     43: sub tag_end {
1.9       albertel   44:   my ($target,$token,$description) = @_;
1.1       albertel   45:   my $result='';
1.4       albertel   46:   if ($target eq 'edit') {
                     47:     my $tag=$token->[1];
1.9       albertel   48:     if (!defined($description)) {
1.14      albertel   49:       $result.="</td></tr><tr><td>&lt;/$tag&gt;</td><td colspan=\"2\">&nbsp;</td>";
1.9       albertel   50:     } else {
1.14      albertel   51:       if ($description ne '') { $result.="</td></tr><tr><td>$description</td><td colspan=\"2\">&nbsp;</td>"; }
1.9       albertel   52:     }
1.12      albertel   53:     $result.="</tr>".&end_table()."\n";
1.4       albertel   54:   }
                     55:   return $result;
                     56: }
1.1       albertel   57: 
1.10      albertel   58: sub start_table {
                     59:   my ($token)=@_;
                     60:   my $tag = $token->[1];
                     61:   my $tagnum;
                     62:   foreach my $namespace (reverse @Apache::lonxml::namespace) {
1.23      albertel   63:     my $testtag=$namespace.'::'.$tag;
1.10      albertel   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++;
1.12      albertel   73:   my $result="<table bgcolor=\"$color\" width=\"100%\" border=\"5\">";
1.10      albertel   74:   return $result;
                     75: }
                     76: 
                     77: sub end_table {
                     78:   $Apache::edit::colordepth--;
                     79:   my $result="</table>";
                     80:   return $result;
                     81: }
                     82: 
1.22      albertel   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: 
1.8       albertel   92: sub deletelist {
                     93:   my ($target,$token) = @_;
                     94:   my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
1.14      albertel   95: <option></option>
                     96: <option>Yes</option>
1.8       albertel   97: </select>";
                     98:   return $result;
                     99: }
                    100: 
1.14      albertel  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: 
1.7       albertel  124: sub get_insert_list {
1.6       albertel  125:   my ($token) = @_;
                    126:   my $result='';
1.7       albertel  127:   my @tagnums= ();
                    128:   #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
1.6       albertel  129:   if ($Apache::lonxml::insertlist{"$token->[1].which"}) {
1.7       albertel  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"} });
1.6       albertel  135:     }
                    136:   }
1.7       albertel  137:   if (@tagnums) {
                    138:     foreach my $tagnum (@tagnums) {
                    139:       $result.='<option value="'.$tagnum.'">'.$Apache::lonxml::insertlist{"$tagnum.description"}."</option>\n";
1.5       albertel  140:     }
                    141:     if ($result) { $result='<option selected="on"></option>'.$result; }
                    142:   }
                    143:   return $result;
                    144: }
                    145: 
1.4       albertel  146: sub insertlist {
1.8       albertel  147:   my ($target,$token) = @_;
1.4       albertel  148:   my $result;
                    149:   if ($target eq 'edit') {
1.5       albertel  150:     my $optionlist= &get_insert_list($token);
                    151:     if ($optionlist) {
                    152:       $result = "Insert:
1.4       albertel  153: <select name=\"insert_$Apache::lonxml::curdepth\">
1.5       albertel  154: $optionlist
1.4       albertel  155: </select>"
1.11      albertel  156:     } else {
                    157:       $result="&nbsp;";
1.6       albertel  158:     }
                    159:   }
                    160:   return $result;
                    161: }
                    162: 
1.7       albertel  163: sub handle_insert {
1.15      albertel  164:   if ($ENV{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
1.6       albertel  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"};
1.7       albertel  170:     my $namespace;
                    171:     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
1.6       albertel  172:     $result.="\n<$newtag>\n</$newtag>";
                    173:   } else {
1.15      albertel  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.");
1.5       albertel  182:     }
                    183:   }
                    184:   return $result;
1.16      albertel  185: }
                    186: 
                    187: sub insert_responseparam {
                    188:   return '
                    189:     <responseparam />';
1.5       albertel  190: }
                    191: 
1.24    ! albertel  192: sub insert_formularesponse {
        !           193:   return '
        !           194: <formularesponse answer="" samples="">
        !           195:     <textline />
        !           196:     <hintgroup>
        !           197:     </hintgroup>
        !           198: </formularesponse>';
        !           199: }
        !           200: 
1.15      albertel  201: sub insert_numericalresponse {
                    202:   return '
                    203: <numericalresponse answer="">
                    204:     <textline />
                    205:     <hintgroup>
                    206:     </hintgroup>
                    207: </numericalresponse>';
                    208: }
                    209: 
1.18      albertel  210: sub insert_stringresponse {
                    211:   return '
                    212: <stringresponse answer="" type="">
                    213:     <textline />
                    214:     <hintgroup>
                    215:     </hintgroup>
                    216: </stringresponse>';
                    217: }
                    218: 
1.7       albertel  219: sub insert_optionresponse {
                    220:   return '
                    221: <optionresponse max="10">
                    222:     <foilgroup options="">
                    223:     </foilgroup>
1.14      albertel  224:     <hintgroup>
                    225:     </hintgroup>
1.7       albertel  226: </optionresponse>';
1.1       albertel  227: }
                    228: 
1.23      albertel  229: sub insert_radiobuttonresponse {
                    230:   return '
                    231: <radiobuttonresponse max="10">
                    232:     <foilgroup>
                    233:     </foilgroup>
                    234:     <hintgroup>
                    235:     </hintgroup>
                    236: </radiobuttonresponse>';
                    237: }
                    238: 
1.21      albertel  239: sub insert_displayduedate { return '<displayduedate />'; }
                    240: sub insert_displaytitle   { return '<displaytitle />'; }
1.22      albertel  241: sub insert_hintpart {
                    242:   return '
                    243: <hintpart on="default">
                    244:     <startouttext/>
                    245:     <endouttext />
                    246: </hintpart>';
                    247: }
                    248: 
                    249: sub insert_numericalhint {
                    250:   return '
                    251: <numericalhint>
                    252: </numericalhint>';
                    253: }
1.21      albertel  254: 
1.23      albertel  255: sub insert_startouttext {
                    256:   return "<startouttext />\n<endouttext />";
                    257: }
                    258: 
                    259: sub insert_script {
                    260:   return "\n<script type=\"loncapa/perl\">\n</script>";
                    261: }
                    262: 
1.2       albertel  263: sub editfield {
1.5       albertel  264:   my ($tag,$data,$description,$minwidth,$minheight)=@_;
1.22      albertel  265: 
1.2       albertel  266:   my $count=0;
                    267:   my $maxlength=-1;
                    268:   map { $count++;
                    269: 	if (length($_) > $maxlength) { $maxlength = length ($_); }
                    270:       } split ("\n", $data);
                    271:   if ($maxlength > 80) { $maxlength = 80; }
1.5       albertel  272:   if ($maxlength < $minwidth) { $maxlength = $minwidth; }
                    273:   if ( $count < $minheight) { $count = $minheight; }
                    274:   if ($description) {
1.9       albertel  275:     $description="<br />".$description."<br />";
1.2       albertel  276:   }
1.9       albertel  277:   return "$description\n&nbsp;&nbsp;&nbsp;<textarea rows=\"$count\" cols=\"$maxlength\" name=homework_edit_".$Apache::lonxml::curdepth.">$data</textarea>\n";
1.2       albertel  278: #  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";
                    279: }
                    280: 
                    281: sub modifiedfield {
                    282:   my ($token) = @_;
1.3       albertel  283:   my $result;
                    284: #  foreach my $envkey (sort keys %ENV) {
                    285: #    &Apache::lonxml::debug("$envkey ---- $ENV{$envkey}");
                    286: #  }
                    287: #  &Apache::lonxml::debug("I want homework_edit_$Apache::lonxml::curdepth");
                    288: #  &Apache::lonxml::debug($ENV{"form.homework_edit_$Apache::lonxml::curdepth"});
                    289:   $result=$ENV{"form.homework_edit_$Apache::lonxml::curdepth"};
                    290:   if (defined $token) {
                    291:     if (defined $token->[4]) {
                    292:       $result=$token->[4].$result;
                    293:     } else {
                    294:       $result=$result.$token->[2];
                    295:     }
1.2       albertel  296:   }
1.3       albertel  297:   return $result;
1.2       albertel  298: }
                    299: 
1.15      albertel  300: # Returns a 1 if the token has been modified and you should rebuild the tag
1.12      albertel  301: # side-effects, will modify the $token if new values are found
                    302: sub get_new_args {
                    303:   my ($token,$parstack,$safeeval,@args)=@_;
                    304:   my $rebuild=0;
                    305:   foreach my $arg (@args) {
1.20      albertel  306:     #just want the string that it was set to
                    307:     my $value=$token->[2]->{$arg};
1.12      albertel  308:     my $newvalue=$ENV{"form.$Apache::lonxml::curdepth.$arg"};
                    309:     &Apache::lonxml::debug(" for:$arg: cur is :$value: new is :$newvalue:");
                    310:     if ($value ne $newvalue) {
                    311:       $token->[2]->{$arg}=$newvalue;
                    312:       $rebuild=1;
                    313:     }
                    314:   }
                    315:   return $rebuild;
                    316: }
                    317: 
1.15      albertel  318: # looks for /> on start tags
1.12      albertel  319: sub rebuild_tag {
                    320:   my ($token) = @_;
                    321:   my $result;
                    322:   if ($token->[0] eq 'S') {
                    323:     $result = '<'.$token->[1];
                    324:     while (my ($key,$val)= each(%{$token->[2]})) {
1.20      albertel  325:       $val=~s:^\s+|\s+$::g;
1.17      albertel  326:       $val=~s:"::g; #"
1.12      albertel  327:       &Apache::lonxml::debug("setting :$key: to  :$val:");
                    328:       $result.=' '.$key.'="'.$val.'"';
                    329:     }
1.15      albertel  330:     if ($token->[4] =~ m:/>$:) {
                    331:       $result.=' />';
                    332:     } else {
                    333:       $result.='>';
                    334:     }
1.12      albertel  335:   } elsif ( $token->[0] eq 'E' ) {
                    336:     $result = '</'.$token->[1].'>';
                    337:   }
                    338:   return $result;
                    339: }
1.13      albertel  340: 
                    341: sub text_arg {
                    342:   my ($description,$name,$token,$size) = @_;
                    343:   my $result;
                    344:   if (!defined $size) { $size=20; }
                    345:   my $arg=$token->[2]{$name};
                    346:   $result=$description.'<input name="'."$Apache::lonxml::curdepth.$name".
                    347:     '" type="text" value="'.$arg.'" size="'.$size.'" />';
                    348:   return $result;
                    349: }
                    350: 
                    351: sub select_arg {
                    352:   my ($description,$name,$list,$token) = @_;
                    353:   my $result;
                    354:   my $optionlist="";
                    355:   my $selected=$token->[2]{$name};
                    356:   foreach my $option (@$list) {
                    357:     if ( $selected eq $option ) {
                    358:       $optionlist.="<option selected=\"on\">$option</option>\n";
                    359:     } else {
                    360:       $optionlist.="<option>$option</option>\n";
                    361:     }
                    362:   }
                    363:   $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
                    364:        '.$optionlist.'
                    365:       </select></td></tr><tr><td colspan="3">';
                    366:   return $result;
                    367: }
                    368: 
1.19      albertel  369: sub select_or_text_arg {
                    370:   my ($description,$name,$list,$token,$size) = @_;
                    371:   my $result;
                    372:   my $optionlist="";
                    373:   my $found=0;
                    374:   my $selected=$token->[2]{$name};
                    375:   foreach my $option (@$list) {
                    376:     if ( $selected eq $option ) {
                    377:       $optionlist.="<option selected=\"on\">$option</option>\n";
                    378:       $found=1;
                    379:     } else {
                    380:       $optionlist.="<option>$option</option>\n";
                    381:     }
                    382:   }
                    383:   $optionlist.="<option value=\"TYPEDINVALUE\">Type in value</option>\n";
                    384:   if ($found) {
                    385:     $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
                    386:        '.$optionlist.'
                    387:       </select></td></tr><tr><td colspan="3">';
                    388:   } else {
                    389:     $result.=&text_arg($description,$name,$token,$size);
                    390:   }
                    391:   return $result;
                    392: }
1.1       albertel  393: 1;
                    394: __END__

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