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

1.1       albertel    1: # The LearningOnline Network with CAPA 
                      2: # edit mode helpers
1.25      albertel    3: #
1.26    ! harris41    4: # $Id: edit.pm,v 1.25 2001/12/04 14:47:33 albertel Exp $
1.25      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: # 3/20 Guy
                     29: package Apache::edit; 
                     30: 
                     31: use strict;
                     32: use Apache::lonnet;
                     33: 
1.10      albertel   34: # Global Vars
                     35: # default list of colors to use in editing
                     36: @Apache::edit::colorlist=('#ffffff','#ff0000','#00ff00','#0000ff','#0ff000','#000ff0','#f0000f');
                     37: # depth of nesting of edit
                     38: $Apache::edit::colordepth=0;
                     39: 
                     40: sub initialize_edit {
                     41:   $Apache::edit::colordepth=0;
                     42: }
                     43: 
1.1       albertel   44: sub tag_start {
1.9       albertel   45:   my ($target,$token,$description) = @_;
1.1       albertel   46:   my $result='';
1.5       albertel   47:   if ($target eq "edit") {
1.4       albertel   48:     my $tag=$token->[1];
1.22      albertel   49:     if (!$description) {
                     50:       $description=&Apache::lonxml::description($token);
                     51:       if (!$description) { $description="<$tag>"; }
                     52:     }
1.10      albertel   53:     $result.= &start_table($token)."<tr><td>$description</td>
1.14      albertel   54: <td>Delete".
1.8       albertel   55:   &deletelist($target,$token)
                     56:   ."</td>
1.4       albertel   57: <td>".
1.8       albertel   58:   &insertlist($target,$token).
1.4       albertel   59:     "</td>
1.1       albertel   60: </tr><tr><td colspan=\"3\">\n";
1.22      albertel   61: #<td>".
                     62: #  &movebuttons($target,$token).
                     63: #    "</tr><tr><td colspan=\"3\">\n";
1.4       albertel   64:   }
1.1       albertel   65:   return $result;
                     66: }
                     67: 
                     68: sub tag_end {
1.9       albertel   69:   my ($target,$token,$description) = @_;
1.1       albertel   70:   my $result='';
1.4       albertel   71:   if ($target eq 'edit') {
                     72:     my $tag=$token->[1];
1.9       albertel   73:     if (!defined($description)) {
1.14      albertel   74:       $result.="</td></tr><tr><td>&lt;/$tag&gt;</td><td colspan=\"2\">&nbsp;</td>";
1.9       albertel   75:     } else {
1.14      albertel   76:       if ($description ne '') { $result.="</td></tr><tr><td>$description</td><td colspan=\"2\">&nbsp;</td>"; }
1.9       albertel   77:     }
1.12      albertel   78:     $result.="</tr>".&end_table()."\n";
1.4       albertel   79:   }
                     80:   return $result;
                     81: }
1.1       albertel   82: 
1.10      albertel   83: sub start_table {
                     84:   my ($token)=@_;
                     85:   my $tag = $token->[1];
                     86:   my $tagnum;
                     87:   foreach my $namespace (reverse @Apache::lonxml::namespace) {
1.23      albertel   88:     my $testtag=$namespace.'::'.$tag;
1.10      albertel   89:     $tagnum=$Apache::lonxml::insertlist{"$testtag.num"};
                     90:     if (defined($tagnum)) { last; }
                     91:   }
                     92:   if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
                     93:   my $color = $Apache::lonxml::insertlist{"$tagnum.color"};
                     94:   if (!defined($color)) {
                     95:     $color = $Apache::edit::colorlist[$Apache::edit::colordepth];
                     96:   }
                     97:   $Apache::edit::colordepth++;
1.12      albertel   98:   my $result="<table bgcolor=\"$color\" width=\"100%\" border=\"5\">";
1.10      albertel   99:   return $result;
                    100: }
                    101: 
                    102: sub end_table {
                    103:   $Apache::edit::colordepth--;
                    104:   my $result="</table>";
                    105:   return $result;
                    106: }
                    107: 
1.22      albertel  108: sub movebuttons {
                    109:   my ($target,$token) = @_;
                    110:   my $result='<input type="submit" name="moveup.'.
                    111:     $Apache::lonxml::curdepth.'" value="Move Up" />';
                    112:   $result.='<input type="submit" name="movedown.'.
                    113:     $Apache::lonxml::curdepth.'" value="Move Down" />';
                    114:   return $result;
                    115: }
                    116: 
1.8       albertel  117: sub deletelist {
                    118:   my ($target,$token) = @_;
                    119:   my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
1.14      albertel  120: <option></option>
                    121: <option>Yes</option>
1.8       albertel  122: </select>";
                    123:   return $result;
                    124: }
                    125: 
1.14      albertel  126: sub handle_delete {
                    127:   if (!$ENV{"form.delete_$Apache::lonxml::curdepth"}) { return ''; }
                    128:   my ($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    129:   my $result=0;
                    130:   if ($space) {
                    131:     my $sub1="$space\:\:delete_$token->[1]";
                    132:     {
                    133:       no strict 'refs';
                    134:       if (defined &$sub1) {
                    135: 	$result=&$sub1($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
                    136:       }
                    137:     }
                    138:   }
                    139:   if (!$result) {
                    140:     my $endtag='/'.$token->[1];
                    141:     my $bodytext=&Apache::lonxml::get_all_text($endtag,$$parser[$#$parser]);
                    142:     $$parser['-1']->get_token();
                    143:     &Apache::lonxml::debug("Deleting :$bodytext: for $token->[1]");
                    144:     &Apache::lonxml::end_tag($tagstack,$parstack,$token);
                    145:   }
                    146:   return 1;
                    147: }
                    148: 
1.7       albertel  149: sub get_insert_list {
1.6       albertel  150:   my ($token) = @_;
                    151:   my $result='';
1.7       albertel  152:   my @tagnums= ();
                    153:   #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
1.6       albertel  154:   if ($Apache::lonxml::insertlist{"$token->[1].which"}) {
1.7       albertel  155:     push (@tagnums, @{ $Apache::lonxml::insertlist{"$token->[1].which"} });
                    156:   }
                    157:   foreach my $namespace (@Apache::lonxml::namespace) {
                    158:     if ($Apache::lonxml::insertlist{"$namespace".'::'."$token->[1].which"}) {
                    159:       push (@tagnums, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$token->[1].which"} });
1.6       albertel  160:     }
                    161:   }
1.7       albertel  162:   if (@tagnums) {
                    163:     foreach my $tagnum (@tagnums) {
                    164:       $result.='<option value="'.$tagnum.'">'.$Apache::lonxml::insertlist{"$tagnum.description"}."</option>\n";
1.5       albertel  165:     }
                    166:     if ($result) { $result='<option selected="on"></option>'.$result; }
                    167:   }
                    168:   return $result;
                    169: }
                    170: 
1.4       albertel  171: sub insertlist {
1.8       albertel  172:   my ($target,$token) = @_;
1.4       albertel  173:   my $result;
                    174:   if ($target eq 'edit') {
1.5       albertel  175:     my $optionlist= &get_insert_list($token);
                    176:     if ($optionlist) {
                    177:       $result = "Insert:
1.4       albertel  178: <select name=\"insert_$Apache::lonxml::curdepth\">
1.5       albertel  179: $optionlist
1.4       albertel  180: </select>"
1.11      albertel  181:     } else {
                    182:       $result="&nbsp;";
1.6       albertel  183:     }
                    184:   }
                    185:   return $result;
                    186: }
                    187: 
1.7       albertel  188: sub handle_insert {
1.15      albertel  189:   if ($ENV{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
1.6       albertel  190:   my $result;
                    191:   my $tagnum = $ENV{"form.insert_$Apache::lonxml::curdepth"};
                    192:   my $func=$Apache::lonxml::insertlist{"$tagnum.function"};
                    193:   if ($func eq 'default') {
                    194:     my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
1.7       albertel  195:     my $namespace;
                    196:     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
1.6       albertel  197:     $result.="\n<$newtag>\n</$newtag>";
                    198:   } else {
1.15      albertel  199:     if (defined(&$func)) {
                    200:       {
                    201: 	no strict 'refs';
                    202: 	$result.=&$func();
                    203:       }
                    204:     } else {
                    205:       my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"};
                    206:       &Apache::lonxml::error("Unable to insert tag $newtag, $func was not defined.");
1.5       albertel  207:     }
                    208:   }
                    209:   return $result;
1.16      albertel  210: }
                    211: 
                    212: sub insert_responseparam {
                    213:   return '
                    214:     <responseparam />';
1.5       albertel  215: }
                    216: 
1.24      albertel  217: sub insert_formularesponse {
                    218:   return '
                    219: <formularesponse answer="" samples="">
                    220:     <textline />
                    221:     <hintgroup>
                    222:     </hintgroup>
                    223: </formularesponse>';
                    224: }
                    225: 
1.15      albertel  226: sub insert_numericalresponse {
                    227:   return '
                    228: <numericalresponse answer="">
                    229:     <textline />
                    230:     <hintgroup>
                    231:     </hintgroup>
                    232: </numericalresponse>';
                    233: }
                    234: 
1.18      albertel  235: sub insert_stringresponse {
                    236:   return '
                    237: <stringresponse answer="" type="">
                    238:     <textline />
                    239:     <hintgroup>
                    240:     </hintgroup>
                    241: </stringresponse>';
                    242: }
                    243: 
1.7       albertel  244: sub insert_optionresponse {
                    245:   return '
                    246: <optionresponse max="10">
                    247:     <foilgroup options="">
                    248:     </foilgroup>
1.14      albertel  249:     <hintgroup>
                    250:     </hintgroup>
1.7       albertel  251: </optionresponse>';
1.1       albertel  252: }
                    253: 
1.23      albertel  254: sub insert_radiobuttonresponse {
                    255:   return '
                    256: <radiobuttonresponse max="10">
                    257:     <foilgroup>
                    258:     </foilgroup>
                    259:     <hintgroup>
                    260:     </hintgroup>
                    261: </radiobuttonresponse>';
                    262: }
                    263: 
1.21      albertel  264: sub insert_displayduedate { return '<displayduedate />'; }
                    265: sub insert_displaytitle   { return '<displaytitle />'; }
1.22      albertel  266: sub insert_hintpart {
                    267:   return '
                    268: <hintpart on="default">
                    269:     <startouttext/>
                    270:     <endouttext />
                    271: </hintpart>';
                    272: }
                    273: 
                    274: sub insert_numericalhint {
                    275:   return '
                    276: <numericalhint>
                    277: </numericalhint>';
                    278: }
1.21      albertel  279: 
1.23      albertel  280: sub insert_startouttext {
                    281:   return "<startouttext />\n<endouttext />";
                    282: }
                    283: 
                    284: sub insert_script {
                    285:   return "\n<script type=\"loncapa/perl\">\n</script>";
                    286: }
                    287: 
1.25      albertel  288: sub textarea_sizes {
                    289:   my ($data)=@_;
                    290:   my $count=0;
                    291:   my $maxlength=-1;
1.26    ! harris41  292:   foreach (split ("\n", $$data)) { $count++;
1.25      albertel  293: 	if (length($_) > $maxlength) { $maxlength = length($_); }
1.26    ! harris41  294:       }
1.25      albertel  295:   my $rows = $count;
                    296:   my $cols = $maxlength;
                    297:   return ($rows,$cols);
                    298: }
                    299: 
1.2       albertel  300: sub editfield {
1.5       albertel  301:   my ($tag,$data,$description,$minwidth,$minheight)=@_;
1.22      albertel  302: 
1.25      albertel  303:   my ($rows,$cols)=&textarea_sizes(\$data);
                    304:   if ($cols > 80) { $cols = 80; }
                    305:   if ($cols < $minwidth ) { $cols = $minwidth; }
                    306:   if ($rows < $minheight) { $rows = $minheight; }
                    307:   if ($description) { $description="<br />".$description."<br />"; }
                    308:   return "$description\n&nbsp;&nbsp;&nbsp;<textarea rows=\"$rows\" cols=\"$cols\" name=\"homework_edit_".$Apache::lonxml::curdepth."\">$data</textarea>\n";
1.2       albertel  309: }
                    310: 
                    311: sub modifiedfield {
                    312:   my ($token) = @_;
1.3       albertel  313:   my $result;
                    314: #  foreach my $envkey (sort keys %ENV) {
                    315: #    &Apache::lonxml::debug("$envkey ---- $ENV{$envkey}");
                    316: #  }
                    317: #  &Apache::lonxml::debug("I want homework_edit_$Apache::lonxml::curdepth");
                    318: #  &Apache::lonxml::debug($ENV{"form.homework_edit_$Apache::lonxml::curdepth"});
                    319:   $result=$ENV{"form.homework_edit_$Apache::lonxml::curdepth"};
                    320:   if (defined $token) {
                    321:     if (defined $token->[4]) {
                    322:       $result=$token->[4].$result;
                    323:     } else {
                    324:       $result=$result.$token->[2];
                    325:     }
1.2       albertel  326:   }
1.3       albertel  327:   return $result;
1.2       albertel  328: }
                    329: 
1.15      albertel  330: # Returns a 1 if the token has been modified and you should rebuild the tag
1.12      albertel  331: # side-effects, will modify the $token if new values are found
                    332: sub get_new_args {
                    333:   my ($token,$parstack,$safeeval,@args)=@_;
                    334:   my $rebuild=0;
                    335:   foreach my $arg (@args) {
1.20      albertel  336:     #just want the string that it was set to
                    337:     my $value=$token->[2]->{$arg};
1.12      albertel  338:     my $newvalue=$ENV{"form.$Apache::lonxml::curdepth.$arg"};
                    339:     &Apache::lonxml::debug(" for:$arg: cur is :$value: new is :$newvalue:");
                    340:     if ($value ne $newvalue) {
                    341:       $token->[2]->{$arg}=$newvalue;
                    342:       $rebuild=1;
                    343:     }
                    344:   }
                    345:   return $rebuild;
                    346: }
                    347: 
1.15      albertel  348: # looks for /> on start tags
1.12      albertel  349: sub rebuild_tag {
                    350:   my ($token) = @_;
                    351:   my $result;
                    352:   if ($token->[0] eq 'S') {
                    353:     $result = '<'.$token->[1];
                    354:     while (my ($key,$val)= each(%{$token->[2]})) {
1.20      albertel  355:       $val=~s:^\s+|\s+$::g;
1.17      albertel  356:       $val=~s:"::g; #"
1.12      albertel  357:       &Apache::lonxml::debug("setting :$key: to  :$val:");
                    358:       $result.=' '.$key.'="'.$val.'"';
                    359:     }
1.15      albertel  360:     if ($token->[4] =~ m:/>$:) {
                    361:       $result.=' />';
                    362:     } else {
                    363:       $result.='>';
                    364:     }
1.12      albertel  365:   } elsif ( $token->[0] eq 'E' ) {
                    366:     $result = '</'.$token->[1].'>';
                    367:   }
                    368:   return $result;
                    369: }
1.13      albertel  370: 
                    371: sub text_arg {
                    372:   my ($description,$name,$token,$size) = @_;
                    373:   my $result;
                    374:   if (!defined $size) { $size=20; }
                    375:   my $arg=$token->[2]{$name};
                    376:   $result=$description.'<input name="'."$Apache::lonxml::curdepth.$name".
                    377:     '" type="text" value="'.$arg.'" size="'.$size.'" />';
                    378:   return $result;
                    379: }
                    380: 
                    381: sub select_arg {
                    382:   my ($description,$name,$list,$token) = @_;
                    383:   my $result;
                    384:   my $optionlist="";
                    385:   my $selected=$token->[2]{$name};
                    386:   foreach my $option (@$list) {
                    387:     if ( $selected eq $option ) {
                    388:       $optionlist.="<option selected=\"on\">$option</option>\n";
                    389:     } else {
                    390:       $optionlist.="<option>$option</option>\n";
                    391:     }
                    392:   }
                    393:   $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
                    394:        '.$optionlist.'
                    395:       </select></td></tr><tr><td colspan="3">';
                    396:   return $result;
                    397: }
                    398: 
1.19      albertel  399: sub select_or_text_arg {
                    400:   my ($description,$name,$list,$token,$size) = @_;
                    401:   my $result;
                    402:   my $optionlist="";
                    403:   my $found=0;
                    404:   my $selected=$token->[2]{$name};
                    405:   foreach my $option (@$list) {
                    406:     if ( $selected eq $option ) {
                    407:       $optionlist.="<option selected=\"on\">$option</option>\n";
                    408:       $found=1;
                    409:     } else {
                    410:       $optionlist.="<option>$option</option>\n";
                    411:     }
                    412:   }
                    413:   $optionlist.="<option value=\"TYPEDINVALUE\">Type in value</option>\n";
                    414:   if ($found) {
                    415:     $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
                    416:        '.$optionlist.'
                    417:       </select></td></tr><tr><td colspan="3">';
                    418:   } else {
                    419:     $result.=&text_arg($description,$name,$token,$size);
                    420:   }
                    421:   return $result;
                    422: }
1.1       albertel  423: 1;
                    424: __END__
1.26    ! harris41  425: 
        !           426: =head1 NAME
        !           427: 
        !           428: Apache::edit - edit mode helpers
        !           429: 
        !           430: =head1 SYNOPSIS
        !           431: 
        !           432: Invoked by many homework and xml related modules.
        !           433: 
        !           434:  &Apache::edit::SUBROUTINENAME(ARGUMENTS);
        !           435: 
        !           436: =head1 INTRODUCTION
        !           437: 
        !           438: This module outputs HTML syntax helpful for the rendering of edit
        !           439: mode interfaces.
        !           440: 
        !           441: This is part of the LearningOnline Network with CAPA project
        !           442: described at http://www.lon-capa.org.
        !           443: 
        !           444: =head1 HANDLER SUBROUTINE
        !           445: 
        !           446: There is no handler subroutine.
        !           447: 
        !           448: =head1 OTHER SUBROUTINES
        !           449: 
        !           450: =over 4
        !           451: 
        !           452: =item *
        !           453: 
        !           454: initialize_edit() : initialize edit (set colordepth to zero)
        !           455: 
        !           456: =item *
        !           457: 
        !           458: tag_start($target,$token,$description) : provide deletion and insertion lists
        !           459: for the manipulation of a start tag; return a scalar string
        !           460: 
        !           461: =item *
        !           462: 
        !           463: tag_end($target,$token,$description) : ending syntax corresponding to
        !           464: &tag_start. return a scalar string.
        !           465: 
        !           466: =item *
        !           467: 
        !           468: start_table($token) : start table; update colordepth; return scalar string.
        !           469: 
        !           470: =item *
        !           471: 
        !           472: end_table() : reduce color depth; end table; return scalar string
        !           473: 
        !           474: =item *
        !           475: 
        !           476: movebuttons($target,$token) : move-up and move-down buttons; return scalar
        !           477: string
        !           478: 
        !           479: =item *
        !           480: 
        !           481: deletelist($target,$token) : provide a yes option in an HTML select element;
        !           482: return scalar string
        !           483: 
        !           484: =item *
        !           485: 
        !           486: handle_delete($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,
        !           487: $style) : respond to a user delete request by passing relevant stack
        !           488: and array information to various rendering functions; return a scalar string
        !           489: 
        !           490: =item *
        !           491: 
        !           492: get_insert_list($token) : provide an insertion list based on possibilities
        !           493: from lonxml; return a scalar string
        !           494: 
        !           495: =item *
        !           496: 
        !           497: insertlist($target,$token) : api that uses get_insert_list;
        !           498: return a scalar string
        !           499: 
        !           500: =item *
        !           501: 
        !           502: handleinsert($token) : provide an insertion list based on possibilities
        !           503: from lonxml; return a scalar string
        !           504: 
        !           505: =item *
        !           506: 
        !           507: get_insert_list($token) : provide an insertion list based on possibilities
        !           508: from lonxml; return a scalar string
        !           509: 
        !           510: =back
        !           511: 
        !           512: incomplete...
        !           513: 
        !           514: =cut

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