File:  [LON-CAPA] / loncom / homework / edit.pm
Revision 1.36: download - view: text, annotated - select for diffs
Wed Aug 7 16:23:05 2002 UTC (21 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: version_0_5_1, version_0_5, HEAD
- improving the editability of essayresponses and textfields

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

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