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

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

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