Return to edit.pm CVS log

Up to [LON-CAPA] / loncom / homework

Update to use edit::end_row() and edit::start_spanning_row() as a cleanup
for edit::select_arg and edit::select_or_text_arg.

    1: # The LearningOnline Network with CAPA 
    2: # edit mode helpers
    3: #
    4: # $Id: edit.pm,v 1.27 2002/01/11 16:32:29 matthew Exp $
    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: #
   28: # 3/20 Guy
   29: # 01/10/02 Matthew
   30: package Apache::edit; 
   31: 
   32: use strict;
   33: use Apache::lonnet;
   34: 
   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: 
   45: sub tag_start {
   46:   my ($target,$token,$description) = @_;
   47:   my $result='';
   48:   if ($target eq "edit") {
   49:     my $tag=$token->[1];
   50:     if (!$description) {
   51:       $description=&Apache::lonxml::description($token);
   52:       if (!$description) { $description="<$tag>"; }
   53:     }
   54:     $result.= &start_table($token)."<tr><td>$description</td>
   55: <td>Delete".
   56:   &deletelist($target,$token)
   57:   ."</td>
   58: <td>".
   59:     &insertlist($target,$token).&end_row().&start_spanning_row();
   60: #<td>". 
   61: #  &movebuttons($target,$token).
   62: #    "</tr><tr><td colspan=\"3\">\n";
   63:   }
   64:   return $result;
   65: }
   66: 
   67: sub tag_end {
   68:   my ($target,$token,$description) = @_;
   69:   my $result='';
   70:   if ($target eq 'edit') {
   71:     my $tag=$token->[1];
   72:     if (!defined($description)) {
   73:       $result.="</td></tr><tr><td>&lt;/$tag&gt;</td><td colspan=\"2\">&nbsp;</td>";
   74:     } else {
   75:       if ($description ne '') { $result.="</td></tr><tr><td>$description</td><td colspan=\"2\">&nbsp;</td>"; }
   76:     }
   77:     $result.="</tr>".&end_table()."\n";
   78:   }
   79:   return $result;
   80: }
   81: 
   82: sub start_table {
   83:   my ($token)=@_;
   84:   my $tag = $token->[1];
   85:   my $tagnum;
   86:   foreach my $namespace (reverse @Apache::lonxml::namespace) {
   87:     my $testtag=$namespace.'::'.$tag;
   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++;
   97:   my $result="<table bgcolor=\"$color\" width=\"100%\" border=\"5\">";
   98:   return $result;
   99: }
  100: 
  101: sub end_table {
  102:   $Apache::edit::colordepth--;
  103:   my $result="</table>";
  104:   return $result;
  105: }
  106: 
  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: 
  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: 
  120: sub deletelist {
  121:   my ($target,$token) = @_;
  122:   my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
  123: <option></option>
  124: <option>Yes</option>
  125: </select>";
  126:   return $result;
  127: }
  128: 
  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: 
  152: sub get_insert_list {
  153:   my ($token) = @_;
  154:   my $result='';
  155:   my @tagnums= ();
  156:   #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
  157:   if ($Apache::lonxml::insertlist{"$token->[1].which"}) {
  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"} });
  163:     }
  164:   }
  165:   if (@tagnums) {
  166:     foreach my $tagnum (@tagnums) {
  167:       $result.='<option value="'.$tagnum.'">'.$Apache::lonxml::insertlist{"$tagnum.description"}."</option>\n";
  168:     }
  169:     if ($result) { $result='<option selected="on"></option>'.$result; }
  170:   }
  171:   return $result;
  172: }
  173: 
  174: sub insertlist {
  175:   my ($target,$token) = @_;
  176:   my $result;
  177:   if ($target eq 'edit') {
  178:     my $optionlist= &get_insert_list($token);
  179:     if ($optionlist) {
  180:       $result = "Insert:
  181: <select name=\"insert_$Apache::lonxml::curdepth\">
  182: $optionlist
  183: </select>"
  184:     } else {
  185:       $result="&nbsp;";
  186:     }
  187:   }
  188:   return $result;
  189: }
  190: 
  191: sub handle_insert {
  192:   if ($ENV{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
  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"};
  198:     my $namespace;
  199:     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
  200:     $result.="\n<$newtag>\n</$newtag>";
  201:   } else {
  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.");
  210:     }
  211:   }
  212:   return $result;
  213: }
  214: 
  215: sub insert_responseparam {
  216:   return '
  217:     <responseparam />';
  218: }
  219: 
  220: sub insert_formularesponse {
  221:   return '
  222: <formularesponse answer="" samples="">
  223:     <textline />
  224:     <hintgroup>
  225:     </hintgroup>
  226: </formularesponse>';
  227: }
  228: 
  229: sub insert_numericalresponse {
  230:   return '
  231: <numericalresponse answer="">
  232:     <textline />
  233:     <hintgroup>
  234:     </hintgroup>
  235: </numericalresponse>';
  236: }
  237: 
  238: sub insert_stringresponse {
  239:   return '
  240: <stringresponse answer="" type="">
  241:     <textline />
  242:     <hintgroup>
  243:     </hintgroup>
  244: </stringresponse>';
  245: }
  246: 
  247: sub insert_optionresponse {
  248:   return '
  249: <optionresponse max="10">
  250:     <foilgroup options="">
  251:     </foilgroup>
  252:     <hintgroup>
  253:     </hintgroup>
  254: </optionresponse>';
  255: }
  256: 
  257: sub insert_radiobuttonresponse {
  258:   return '
  259: <radiobuttonresponse max="10">
  260:     <foilgroup>
  261:     </foilgroup>
  262:     <hintgroup>
  263:     </hintgroup>
  264: </radiobuttonresponse>';
  265: }
  266: 
  267: sub insert_displayduedate { return '<displayduedate />'; }
  268: sub insert_displaytitle   { return '<displaytitle />'; }
  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: }
  282: 
  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: 
  291: sub textarea_sizes {
  292:   my ($data)=@_;
  293:   my $count=0;
  294:   my $maxlength=-1;
  295:   foreach (split ("\n", $$data)) { $count++;
  296: 	if (length($_) > $maxlength) { $maxlength = length($_); }
  297:       }
  298:   my $rows = $count;
  299:   my $cols = $maxlength;
  300:   return ($rows,$cols);
  301: }
  302: 
  303: sub editfield {
  304:   my ($tag,$data,$description,$minwidth,$minheight)=@_;
  305: 
  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";
  312: }
  313: 
  314: sub modifiedfield {
  315:   my ($token) = @_;
  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:   if (defined $token) {
  324:     if (defined $token->[4]) {
  325:       $result=$token->[4].$result;
  326:     } else {
  327:       $result=$result.$token->[2];
  328:     }
  329:   }
  330:   return $result;
  331: }
  332: 
  333: # Returns a 1 if the token has been modified and you should rebuild the tag
  334: # side-effects, will modify the $token if new values are found
  335: sub get_new_args {
  336:   my ($token,$parstack,$safeeval,@args)=@_;
  337:   my $rebuild=0;
  338:   foreach my $arg (@args) {
  339:     #just want the string that it was set to
  340:     my $value=$token->[2]->{$arg};
  341:     my $newvalue=$ENV{"form.$Apache::lonxml::curdepth.$arg"};
  342:     &Apache::lonxml::debug(" for:$arg: cur is :$value: new is :$newvalue:");
  343:     if ($value ne $newvalue) {
  344:       $token->[2]->{$arg}=$newvalue;
  345:       $rebuild=1;
  346:     }
  347:   }
  348:   return $rebuild;
  349: }
  350: 
  351: # looks for /> on start tags
  352: sub rebuild_tag {
  353:   my ($token) = @_;
  354:   my $result;
  355:   if ($token->[0] eq 'S') {
  356:     $result = '<'.$token->[1];
  357:     while (my ($key,$val)= each(%{$token->[2]})) {
  358:       $val=~s:^\s+|\s+$::g;
  359:       $val=~s:"::g; #"
  360:       &Apache::lonxml::debug("setting :$key: to  :$val:");
  361:       $result.=' '.$key.'="'.$val.'"';
  362:     }
  363:     if ($token->[4] =~ m:/>$:) {
  364:       $result.=' />';
  365:     } else {
  366:       $result.='>';
  367:     }
  368:   } elsif ( $token->[0] eq 'E' ) {
  369:     $result = '</'.$token->[1].'>';
  370:   }
  371:   return $result;
  372: }
  373: 
  374: sub text_arg {
  375:   my ($description,$name,$token,$size) = @_;
  376:   my $result;
  377:   if (!defined $size) { $size=20; }
  378:   my $arg=$token->[2]{$name};
  379:   $result=$description.'<input name="'."$Apache::lonxml::curdepth.$name".
  380:     '" type="text" value="'.$arg.'" size="'.$size.'" />';
  381:   return $result;
  382: }
  383: 
  384: sub select_arg {
  385:   my ($description,$name,$list,$token) = @_;
  386:   my $result;
  387:   my $optionlist="";
  388:   my $selected=$token->[2]{$name};
  389:   foreach my $option (@$list) {
  390:     if ( $selected eq $option ) {
  391:       $optionlist.="<option selected=\"on\">$option</option>\n";
  392:     } else {
  393:       $optionlist.="<option>$option</option>\n";
  394:     }
  395:   }
  396:   $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
  397:        '.$optionlist.'
  398:       </select>';
  399:   return $result;
  400: }
  401: 
  402: sub select_or_text_arg {
  403:   my ($description,$name,$list,$token,$size) = @_;
  404:   my $result;
  405:   my $optionlist="";
  406:   my $found=0;
  407:   my $selected=$token->[2]{$name};
  408:   foreach my $option (@$list) {
  409:     if ( $selected eq $option ) {
  410:       $optionlist.="<option selected=\"on\">$option</option>\n";
  411:       $found=1;
  412:     } else {
  413:       $optionlist.="<option>$option</option>\n";
  414:     }
  415:   }
  416:   $optionlist.="<option value=\"TYPEDINVALUE\">Type in value</option>\n";
  417:   if ($found) {
  418:     $result.=$description.'<select name="'."$Apache::lonxml::curdepth.$name".'">
  419:        '.$optionlist.'
  420:       </select>';
  421:   } else {
  422:     $result.=&text_arg($description,$name,$token,$size);
  423:   }
  424:   return $result;
  425: }
  426: 1;
  427: __END__
  428: 
  429: =head1 NAME
  430: 
  431: Apache::edit - edit mode helpers
  432: 
  433: =head1 SYNOPSIS
  434: 
  435: Invoked by many homework and xml related modules.
  436: 
  437:  &Apache::edit::SUBROUTINENAME(ARGUMENTS);
  438: 
  439: =head1 INTRODUCTION
  440: 
  441: This module outputs HTML syntax helpful for the rendering of edit
  442: mode interfaces.
  443: 
  444: This is part of the LearningOnline Network with CAPA project
  445: described at http://www.lon-capa.org.
  446: 
  447: =head1 HANDLER SUBROUTINE
  448: 
  449: There is no handler subroutine.
  450: 
  451: =head1 OTHER SUBROUTINES
  452: 
  453: =over 4
  454: 
  455: =item *
  456: 
  457: initialize_edit() : initialize edit (set colordepth to zero)
  458: 
  459: =item *
  460: 
  461: tag_start($target,$token,$description) : provide deletion and insertion lists
  462: for the manipulation of a start tag; return a scalar string
  463: 
  464: =item *
  465: 
  466: tag_end($target,$token,$description) : ending syntax corresponding to
  467: &tag_start. return a scalar string.
  468: 
  469: =item *
  470: 
  471: start_table($token) : start table; update colordepth; return scalar string.
  472: 
  473: =item *
  474: 
  475: end_table() : reduce color depth; end table; return scalar string
  476: 
  477: =item *
  478: 
  479: start_spanning_row() : start a new table row spanning the 'edit' environment.
  480: 
  481: =item *
  482: 
  483: start_row() : start a new table row and element. 
  484: 
  485: =item *
  486: 
  487: end_row() : end current table element and row.
  488: 
  489: =item *
  490: 
  491: movebuttons($target,$token) : move-up and move-down buttons; return scalar
  492: string
  493: 
  494: =item *
  495: 
  496: deletelist($target,$token) : provide a yes option in an HTML select element;
  497: return scalar string
  498: 
  499: =item *
  500: 
  501: handle_delete($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,
  502: $style) : respond to a user delete request by passing relevant stack
  503: and array information to various rendering functions; 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: =item *
  511: 
  512: insertlist($target,$token) : api that uses get_insert_list;
  513: return a scalar string
  514: 
  515: =item *
  516: 
  517: handleinsert($token) : provide an insertion list based on possibilities
  518: from lonxml; return a scalar string
  519: 
  520: =item *
  521: 
  522: get_insert_list($token) : provide an insertion list based on possibilities
  523: from lonxml; return a scalar string
  524: 
  525: =back
  526: 
  527: incomplete...
  528: 
  529: =cut