Return to edit.pm CVS log

Up to [LON-CAPA] / loncom / homework

- broke out the textarea sizing function

    1: # The LearningOnline Network with CAPA 
    2: # edit mode helpers
    3: #
    4: # $Id: edit.pm,v 1.25 2001/12/04 14:47:33 albertel 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: package Apache::edit; 
   30: 
   31: use strict;
   32: use Apache::lonnet;
   33: 
   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: 
   44: sub tag_start {
   45:   my ($target,$token,$description) = @_;
   46:   my $result='';
   47:   if ($target eq "edit") {
   48:     my $tag=$token->[1];
   49:     if (!$description) {
   50:       $description=&Apache::lonxml::description($token);
   51:       if (!$description) { $description="<$tag>"; }
   52:     }
   53:     $result.= &start_table($token)."<tr><td>$description</td>
   54: <td>Delete".
   55:   &deletelist($target,$token)
   56:   ."</td>
   57: <td>".
   58:   &insertlist($target,$token).
   59:     "</td>
   60: </tr><tr><td colspan=\"3\">\n";
   61: #<td>".
   62: #  &movebuttons($target,$token).
   63: #    "</tr><tr><td colspan=\"3\">\n";
   64:   }
   65:   return $result;
   66: }
   67: 
   68: sub tag_end {
   69:   my ($target,$token,$description) = @_;
   70:   my $result='';
   71:   if ($target eq 'edit') {
   72:     my $tag=$token->[1];
   73:     if (!defined($description)) {
   74:       $result.="</td></tr><tr><td>&lt;/$tag&gt;</td><td colspan=\"2\">&nbsp;</td>";
   75:     } else {
   76:       if ($description ne '') { $result.="</td></tr><tr><td>$description</td><td colspan=\"2\">&nbsp;</td>"; }
   77:     }
   78:     $result.="</tr>".&end_table()."\n";
   79:   }
   80:   return $result;
   81: }
   82: 
   83: sub start_table {
   84:   my ($token)=@_;
   85:   my $tag = $token->[1];
   86:   my $tagnum;
   87:   foreach my $namespace (reverse @Apache::lonxml::namespace) {
   88:     my $testtag=$namespace.'::'.$tag;
   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++;
   98:   my $result="<table bgcolor=\"$color\" width=\"100%\" border=\"5\">";
   99:   return $result;
  100: }
  101: 
  102: sub end_table {
  103:   $Apache::edit::colordepth--;
  104:   my $result="</table>";
  105:   return $result;
  106: }
  107: 
  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: 
  117: sub deletelist {
  118:   my ($target,$token) = @_;
  119:   my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
  120: <option></option>
  121: <option>Yes</option>
  122: </select>";
  123:   return $result;
  124: }
  125: 
  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: 
  149: sub get_insert_list {
  150:   my ($token) = @_;
  151:   my $result='';
  152:   my @tagnums= ();
  153:   #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
  154:   if ($Apache::lonxml::insertlist{"$token->[1].which"}) {
  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"} });
  160:     }
  161:   }
  162:   if (@tagnums) {
  163:     foreach my $tagnum (@tagnums) {
  164:       $result.='<option value="'.$tagnum.'">'.$Apache::lonxml::insertlist{"$tagnum.description"}."</option>\n";
  165:     }
  166:     if ($result) { $result='<option selected="on"></option>'.$result; }
  167:   }
  168:   return $result;
  169: }
  170: 
  171: sub insertlist {
  172:   my ($target,$token) = @_;
  173:   my $result;
  174:   if ($target eq 'edit') {
  175:     my $optionlist= &get_insert_list($token);
  176:     if ($optionlist) {
  177:       $result = "Insert:
  178: <select name=\"insert_$Apache::lonxml::curdepth\">
  179: $optionlist
  180: </select>"
  181:     } else {
  182:       $result="&nbsp;";
  183:     }
  184:   }
  185:   return $result;
  186: }
  187: 
  188: sub handle_insert {
  189:   if ($ENV{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
  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"};
  195:     my $namespace;
  196:     if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
  197:     $result.="\n<$newtag>\n</$newtag>";
  198:   } else {
  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.");
  207:     }
  208:   }
  209:   return $result;
  210: }
  211: 
  212: sub insert_responseparam {
  213:   return '
  214:     <responseparam />';
  215: }
  216: 
  217: sub insert_formularesponse {
  218:   return '
  219: <formularesponse answer="" samples="">
  220:     <textline />
  221:     <hintgroup>
  222:     </hintgroup>
  223: </formularesponse>';
  224: }
  225: 
  226: sub insert_numericalresponse {
  227:   return '
  228: <numericalresponse answer="">
  229:     <textline />
  230:     <hintgroup>
  231:     </hintgroup>
  232: </numericalresponse>';
  233: }
  234: 
  235: sub insert_stringresponse {
  236:   return '
  237: <stringresponse answer="" type="">
  238:     <textline />
  239:     <hintgroup>
  240:     </hintgroup>
  241: </stringresponse>';
  242: }
  243: 
  244: sub insert_optionresponse {
  245:   return '
  246: <optionresponse max="10">
  247:     <foilgroup options="">
  248:     </foilgroup>
  249:     <hintgroup>
  250:     </hintgroup>
  251: </optionresponse>';
  252: }
  253: 
  254: sub insert_radiobuttonresponse {
  255:   return '
  256: <radiobuttonresponse max="10">
  257:     <foilgroup>
  258:     </foilgroup>
  259:     <hintgroup>
  260:     </hintgroup>
  261: </radiobuttonresponse>';
  262: }
  263: 
  264: sub insert_displayduedate { return '<displayduedate />'; }
  265: sub insert_displaytitle   { return '<displaytitle />'; }
  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: }
  279: 
  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: 
  288: sub textarea_sizes {
  289:   my ($data)=@_;
  290:   my $count=0;
  291:   my $maxlength=-1;
  292:   map { $count++;
  293: 	if (length($_) > $maxlength) { $maxlength = length($_); }
  294:       } split ("\n", $$data);
  295:   my $rows = $count;
  296:   my $cols = $maxlength;
  297:   return ($rows,$cols);
  298: }
  299: 
  300: sub editfield {
  301:   my ($tag,$data,$description,$minwidth,$minheight)=@_;
  302: 
  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";
  309: }
  310: 
  311: sub modifiedfield {
  312:   my ($token) = @_;
  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:     }
  326:   }
  327:   return $result;
  328: }
  329: 
  330: # Returns a 1 if the token has been modified and you should rebuild the tag
  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) {
  336:     #just want the string that it was set to
  337:     my $value=$token->[2]->{$arg};
  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: 
  348: # looks for /> on start tags
  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]})) {
  355:       $val=~s:^\s+|\s+$::g;
  356:       $val=~s:"::g; #"
  357:       &Apache::lonxml::debug("setting :$key: to  :$val:");
  358:       $result.=' '.$key.'="'.$val.'"';
  359:     }
  360:     if ($token->[4] =~ m:/>$:) {
  361:       $result.=' />';
  362:     } else {
  363:       $result.='>';
  364:     }
  365:   } elsif ( $token->[0] eq 'E' ) {
  366:     $result = '</'.$token->[1].'>';
  367:   }
  368:   return $result;
  369: }
  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: 
  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: }
  423: 1;
  424: __END__