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

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.9       albertel   24:     if (!$description) { $description="<$tag>"; }
1.10      albertel   25:     $result.= &start_table($token)."<tr><td>$description</td>
1.14      albertel   26: <td>Delete".
1.8       albertel   27:   &deletelist($target,$token)
                     28:   ."</td>
1.4       albertel   29: <td>".
1.8       albertel   30:   &insertlist($target,$token).
1.4       albertel   31:     "</td>
1.1       albertel   32: </tr><tr><td colspan=\"3\">\n";
1.4       albertel   33:   }
1.1       albertel   34:   return $result;
                     35: }
                     36: 
                     37: sub tag_end {
1.9       albertel   38:   my ($target,$token,$description) = @_;
1.1       albertel   39:   my $result='';
1.4       albertel   40:   if ($target eq 'edit') {
                     41:     my $tag=$token->[1];
1.9       albertel   42:     if (!defined($description)) {
1.14      albertel   43:       $result.="</td></tr><tr><td>&lt;/$tag&gt;</td><td colspan=\"2\">&nbsp;</td>";
1.9       albertel   44:     } else {
1.14      albertel   45:       if ($description ne '') { $result.="</td></tr><tr><td>$description</td><td colspan=\"2\">&nbsp;</td>"; }
1.9       albertel   46:     }
1.12      albertel   47:     $result.="</tr>".&end_table()."\n";
1.4       albertel   48:   }
                     49:   return $result;
                     50: }
1.1       albertel   51: 
1.10      albertel   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++;
1.12      albertel   67:   my $result="<table bgcolor=\"$color\" width=\"100%\" border=\"5\">";
1.10      albertel   68:   return $result;
                     69: }
                     70: 
                     71: sub end_table {
                     72:   $Apache::edit::colordepth--;
                     73:   my $result="</table>";
                     74:   return $result;
                     75: }
                     76: 
1.8       albertel   77: sub deletelist {
                     78:   my ($target,$token) = @_;
                     79:   my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
1.14      albertel   80: <option></option>
                     81: <option>Yes</option>
1.8       albertel   82: </select>";
                     83:   return $result;
                     84: }
                     85: 
1.14      albertel   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: 
1.7       albertel  109: sub get_insert_list {
1.6       albertel  110:   my ($token) = @_;
                    111:   my $result='';
1.7       albertel  112:   my @tagnums= ();
                    113:   #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
1.6       albertel  114:   if ($Apache::lonxml::insertlist{"$token->[1].which"}) {
1.7       albertel  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"} });
1.6       albertel  120:     }
                    121:   }
1.7       albertel  122:   if (@tagnums) {
                    123:     foreach my $tagnum (@tagnums) {
                    124:       $result.='<option value="'.$tagnum.'">'.$Apache::lonxml::insertlist{"$tagnum.description"}."</option>\n";
1.5       albertel  125:     }
                    126:     if ($result) { $result='<option selected="on"></option>'.$result; }
                    127:   }
                    128:   return $result;
                    129: }
                    130: 
1.4       albertel  131: sub insertlist {
1.8       albertel  132:   my ($target,$token) = @_;
1.4       albertel  133:   my $result;
                    134:   if ($target eq 'edit') {
1.5       albertel  135:     my $optionlist= &get_insert_list($token);
                    136:     if ($optionlist) {
                    137:       $result = "Insert:
1.4       albertel  138: <select name=\"insert_$Apache::lonxml::curdepth\">
1.5       albertel  139: $optionlist
1.4       albertel  140: </select>"
1.11      albertel  141:     } else {
                    142:       $result="&nbsp;";
1.6       albertel  143:     }
                    144:   }
                    145:   return $result;
                    146: }
                    147: 
1.7       albertel  148: sub handle_insert {
1.15      albertel  149:   if ($ENV{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
1.6       albertel  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"};
1.7       albertel  155:     my $namespace;
                    156:     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
1.6       albertel  157:     $result.="\n<$newtag>\n</$newtag>";
                    158:   } else {
1.15      albertel  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.");
1.5       albertel  167:     }
                    168:   }
                    169:   return $result;
1.16      albertel  170: }
                    171: 
                    172: sub insert_responseparam {
                    173:   return '
                    174:     <responseparam />';
1.5       albertel  175: }
                    176: 
1.15      albertel  177: sub insert_numericalresponse {
                    178:   return '
                    179: <numericalresponse answer="">
                    180:     <textline />
                    181:     <hintgroup>
                    182:     </hintgroup>
                    183: </numericalresponse>';
                    184: }
                    185: 
1.18    ! albertel  186: sub insert_stringresponse {
        !           187:   return '
        !           188: <stringresponse answer="" type="">
        !           189:     <textline />
        !           190:     <hintgroup>
        !           191:     </hintgroup>
        !           192: </stringresponse>';
        !           193: }
        !           194: 
1.7       albertel  195: sub insert_optionresponse {
                    196:   return '
                    197: <optionresponse max="10">
                    198:     <foilgroup options="">
                    199:     </foilgroup>
1.14      albertel  200:     <hintgroup>
                    201:     </hintgroup>
1.7       albertel  202: </optionresponse>';
1.1       albertel  203: }
                    204: 
1.2       albertel  205: sub editfield {
1.5       albertel  206:   my ($tag,$data,$description,$minwidth,$minheight)=@_;
1.2       albertel  207:   
                    208:   my $count=0;
                    209:   my $maxlength=-1;
                    210:   map { $count++;
                    211: 	if (length($_) > $maxlength) { $maxlength = length ($_); }
                    212:       } split ("\n", $data);
                    213:   if ($maxlength > 80) { $maxlength = 80; }
1.5       albertel  214:   if ($maxlength < $minwidth) { $maxlength = $minwidth; }
                    215:   if ( $count < $minheight) { $count = $minheight; }
                    216:   if ($description) {
1.9       albertel  217:     $description="<br />".$description."<br />";
1.2       albertel  218:   }
1.9       albertel  219:   return "$description\n&nbsp;&nbsp;&nbsp;<textarea rows=\"$count\" cols=\"$maxlength\" name=homework_edit_".$Apache::lonxml::curdepth.">$data</textarea>\n";
1.2       albertel  220: #  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";
                    221: }
                    222: 
                    223: sub modifiedfield {
                    224:   my ($token) = @_;
1.3       albertel  225:   my $result;
                    226: #  foreach my $envkey (sort keys %ENV) {
                    227: #    &Apache::lonxml::debug("$envkey ---- $ENV{$envkey}");
                    228: #  }
                    229: #  &Apache::lonxml::debug("I want homework_edit_$Apache::lonxml::curdepth");
                    230: #  &Apache::lonxml::debug($ENV{"form.homework_edit_$Apache::lonxml::curdepth"});
                    231:   $result=$ENV{"form.homework_edit_$Apache::lonxml::curdepth"};
                    232:   if (defined $token) {
                    233:     if (defined $token->[4]) {
                    234:       $result=$token->[4].$result;
                    235:     } else {
                    236:       $result=$result.$token->[2];
                    237:     }
1.2       albertel  238:   }
1.3       albertel  239:   return $result;
1.5       albertel  240: }
                    241: 
                    242: sub insert_startouttext {
1.14      albertel  243:   return "<startouttext />\n<endouttext />";
                    244: }
                    245: 
                    246: sub insert_script {
                    247:   return "\n<script type=\"loncapa/perl\">\n</script>";
1.2       albertel  248: }
                    249: 
1.15      albertel  250: # Returns a 1 if the token has been modified and you should rebuild the tag
1.12      albertel  251: # side-effects, will modify the $token if new values are found
                    252: sub get_new_args {
                    253:   my ($token,$parstack,$safeeval,@args)=@_;
                    254:   my $rebuild=0;
                    255:   foreach my $arg (@args) {
                    256:     my $value=&Apache::lonxml::get_param($arg,$parstack,$safeeval);
                    257:     my $newvalue=$ENV{"form.$Apache::lonxml::curdepth.$arg"};
                    258:     &Apache::lonxml::debug(" for:$arg: cur is :$value: new is :$newvalue:");
                    259:     if ($value ne $newvalue) {
                    260:       $token->[2]->{$arg}=$newvalue;
                    261:       $rebuild=1;
                    262:     }
                    263:   }
                    264:   return $rebuild;
                    265: }
                    266: 
1.15      albertel  267: # looks for /> on start tags
1.12      albertel  268: sub rebuild_tag {
                    269:   my ($token) = @_;
                    270:   my $result;
                    271:   if ($token->[0] eq 'S') {
                    272:     $result = '<'.$token->[1];
                    273:     while (my ($key,$val)= each(%{$token->[2]})) {
1.18    ! albertel  274:       $val=~s:^\s|\s$::g;
1.17      albertel  275:       $val=~s:"::g; #"
1.12      albertel  276:       &Apache::lonxml::debug("setting :$key: to  :$val:");
                    277:       $result.=' '.$key.'="'.$val.'"';
                    278:     }
1.15      albertel  279:     if ($token->[4] =~ m:/>$:) {
                    280:       $result.=' />';
                    281:     } else {
                    282:       $result.='>';
                    283:     }
1.12      albertel  284:   } elsif ( $token->[0] eq 'E' ) {
                    285:     $result = '</'.$token->[1].'>';
                    286:   }
                    287:   return $result;
                    288: }
1.13      albertel  289: 
                    290: sub text_arg {
                    291:   my ($description,$name,$token,$size) = @_;
                    292:   my $result;
                    293:   if (!defined $size) { $size=20; }
                    294:   my $arg=$token->[2]{$name};
                    295:   $result=$description.'<input name="'."$Apache::lonxml::curdepth.$name".
                    296:     '" type="text" value="'.$arg.'" size="'.$size.'" />';
                    297:   return $result;
                    298: }
                    299: 
                    300: sub select_arg {
                    301:   my ($description,$name,$list,$token) = @_;
                    302:   my $result;
                    303:   my $optionlist="";
                    304:   my $selected=$token->[2]{$name};
                    305:   foreach my $option (@$list) {
                    306:     if ( $selected eq $option ) {
                    307:       $optionlist.="<option selected=\"on\">$option</option>\n";
                    308:     } else {
                    309:       $optionlist.="<option>$option</option>\n";
                    310:     }
                    311:   }
                    312:   $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
                    313:        '.$optionlist.'
                    314:       </select></td></tr><tr><td colspan="3">';
                    315:   return $result;
                    316: }
                    317: 
1.1       albertel  318: 1;
                    319: __END__

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