File:  [LON-CAPA] / loncom / homework / edit.pm
Revision 1.117: download - view: text, annotated - select for diffs
Mon Nov 10 14:11:16 2008 UTC (15 years, 6 months ago) by jms
Branches: MAIN
CVS tags: HEAD
Added/updated POD documentation

    1: # The LearningOnline Network with CAPA 
    2: # edit mode helpers
    3: #
    4: # $Id: edit.pm,v 1.117 2008/11/10 14:11:16 jms 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: 
   29: =head1 NAME
   30: 
   31: Apache::edit - edit mode helpers
   32: 
   33: =head1 SYNOPSIS
   34: 
   35: Invoked by many homework and xml related modules.
   36: 
   37:  &Apache::edit::SUBROUTINENAME(ARGUMENTS);
   38: 
   39: =head1 INTRODUCTION
   40: 
   41: This module outputs HTML syntax helpful for the rendering of edit
   42: mode interfaces.
   43: 
   44: This is part of the LearningOnline Network with CAPA project
   45: described at http://www.lon-capa.org.
   46: 
   47: =head1 HANDLER SUBROUTINE
   48: 
   49: There is no handler subroutine.
   50: 
   51: =head1 OTHER SUBROUTINES
   52: 
   53: =over 4
   54: 
   55: =item *
   56: 
   57: initialize_edit() : initialize edit (set colordepth to zero)
   58: 
   59: =item *
   60: 
   61: tag_start($target,$token,$description) : provide deletion and insertion lists
   62: for the manipulation of a start tag; return a scalar string
   63: 
   64: =item *
   65: 
   66: tag_end($target,$token,$description) : ending syntax corresponding to
   67: &tag_start. return a scalar string.
   68: 
   69: =item *
   70: 
   71: start_table($token) : start table; update colordepth; return scalar string.
   72: 
   73: =item *
   74: 
   75: end_table() : reduce color depth; end table; return scalar string
   76: 
   77: =item *
   78: 
   79: start_spanning_row() : start a new table row spanning the 'edit' environment.
   80: 
   81: =item *
   82: 
   83: start_row() : start a new table row and element. 
   84: 
   85: =item *
   86: 
   87: end_row() : end current table element and row.
   88: 
   89: =item *
   90: 
   91: movebuttons($target,$token) : move-up and move-down buttons; return scalar
   92: string
   93: 
   94: =item *
   95: 
   96: deletelist($target,$token) : provide a yes option in an HTML select element;
   97: return scalar string
   98: 
   99: =item *
  100: 
  101: handle_delete($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,
  102: $style) : respond to a user delete request by passing relevant stack
  103: and array information to various rendering functions; return a scalar string
  104: 
  105: =item *
  106: 
  107: get_insert_list($token) : provide an insertion list based on possibilities
  108: from lonxml; return a scalar string
  109: 
  110: =item *
  111: 
  112: insertlist($target,$token) : api that uses get_insert_list;
  113: return a scalar string
  114: 
  115: =item *
  116: 
  117: handleinsert($token) : provide an insertion list based on possibilities
  118: from lonxml; return a scalar string
  119: 
  120: =item *
  121: 
  122: get_insert_list($token) : provide an insertion list based on possibilities
  123: from lonxml; return a scalar string
  124: 
  125: =item *
  126: browse($elementname) : provide a link which will open up the filesystem
  127: browser (lonindexer) and, once a file is selected, place the result in
  128: the form element $elementname.
  129: 
  130: =item *
  131: search($elementname) : provide a link which will open up the filesystem
  132: searcher (lonsearchcat) and, once a file is selected, place the result in
  133: the form element $elementname.
  134: 
  135: =item *
  136: editline(tag,data,description,size): Provide a <input type="text" ../> for
  137: single-line text entry.  This is to be used for text enclosed by tags, not
  138: arguements/parameters associated with a tag.
  139: 
  140: =back
  141: 
  142: incomplete...
  143: 
  144: =cut
  145: 
  146: package Apache::edit; 
  147: 
  148: use strict;
  149: use Apache::lonnet;
  150: use HTML::Entities();
  151: use Apache::lonlocal;
  152: use lib '/home/httpd/lib/perl/';
  153: use LONCAPA;
  154:  
  155: 
  156: # Global Vars
  157: # default list of colors to use in editing
  158: @Apache::edit::colorlist=('#ffffff','#ff0000','#00ff00','#0000ff','#0ff000','#000ff0','#f0000f');
  159: # depth of nesting of edit
  160: $Apache::edit::colordepth=0;
  161: @Apache::edit::inserttag=();
  162: # image-type responses: active background image and curdepth at definition
  163: $Apache::edit::bgimgsrc='';
  164: $Apache::edit::bgimgsrccurdepth='';
  165: 
  166: sub initialize_edit {
  167:     $Apache::edit::colordepth=0;
  168:     @Apache::edit::inserttag=();
  169: }
  170: 
  171: sub tag_start {
  172:     my ($target,$token,$description) = @_;
  173:     my $result='';
  174:     if ($target eq "edit") {
  175: 	my $tag=$token->[1];
  176: 	if (!$description) {
  177: 	    $description=&Apache::lonxml::description($token);
  178: 	    if (!$description) { $description="&lt;$tag&gt;"; }
  179: 	}
  180: 	$result.= &start_table($token)."<tr><td>$description</td>
  181:                       <td>".&mt('Delete?').' '.
  182: 		      &deletelist($target,$token)
  183: 		      ."</td>
  184:                        <td>".
  185: 		       &insertlist($target,$token);
  186: #<td>". 
  187: #  &movebuttons($target,$token).
  188: #    "</tr><tr><td colspan=\"3\">\n";
  189: 	my @help = Apache::lonxml::helpinfo($token);
  190: 	if ($help[0]) {
  191: 	    $result .= '</td><td align="right" valign="top">' .
  192: 		Apache::loncommon::help_open_topic(@help);
  193: 	} else { $result .= "</td><td>&nbsp;"; }
  194: 	$result .= &end_row().&start_spanning_row();
  195:     }
  196:     return $result;
  197: }
  198: 
  199: sub tag_end {
  200:     my ($target,$token,$description) = @_;
  201:     my $result='';
  202:     if ($target eq 'edit') {
  203: 	$result.="</td></tr>".&end_table()."\n";
  204:     }
  205:     return $result;
  206: }
  207: 
  208: sub start_table {
  209:     my ($token)=@_;
  210:     my $tag = &Apache::lonxml::get_tag($token);
  211:     
  212:     my $color = $Apache::lonxml::insertlist{"$tag.color"};
  213:     &Apache::lonxml::debug(" $tag -- $color");
  214:     if (!defined($color)) {
  215: 	$color = $Apache::edit::colorlist[$Apache::edit::colordepth];
  216:     }
  217:     $Apache::edit::colordepth++;
  218:     push(@Apache::edit::inserttag,$token->[1]);
  219:     my $result='<div align="right">';
  220:     $result.='<table bgcolor="'.$color.'" width="97%" border="0" cellspacing="5" cellpadding="3">';
  221:     return $result;
  222: }
  223: 
  224: sub end_table {
  225:     $Apache::edit::colordepth--;
  226:     my $result='</table></div>';
  227:     $result.='<div align="left"><table><tr><td>';
  228: 
  229:     my ($tagname,$closingtag);
  230:     if (defined($Apache::edit::inserttag[-2])) {
  231: 	$tagname=$Apache::edit::inserttag[-2];
  232:     } else {
  233: 	if ($Apache::lonhomework::parsing_a_task) {
  234: 	    $tagname='Task';
  235: 	} else {
  236: 	    $tagname='problem';
  237: 	}
  238:     }
  239:     if (defined($Apache::edit::inserttag[-1])) {
  240: 	$closingtag=$Apache::edit::inserttag[-1];
  241:     }
  242:     $result.=&innerinsertlist('edit',$tagname,$closingtag).
  243: 	"</td></tr></table></div>";
  244:     my $last = pop(@Apache::edit::inserttag);
  245:     return $result;
  246: }
  247: 
  248: sub start_spanning_row { return '<tr><td colspan="5" bgcolor="#DDDDDD">';}
  249: sub start_row          { return '<tr><td bgcolor="#DDDDDD">';            }
  250: sub end_row            { return '</td></tr>';          }
  251: 
  252: sub movebuttons {
  253:     my ($target,$token) = @_;
  254:     my $result='<input type="submit" name="moveup.'.
  255: 	$Apache::lonxml::curdepth.'" value="Move Up" />';
  256:     $result.='<input type="submit" name="movedown.'.
  257: 	$Apache::lonxml::curdepth.'" value="Move Down" />';
  258:     return $result;
  259: }
  260: 
  261: sub deletelist {
  262:     my ($target,$token) = @_;
  263:     my $result = "<select name=\"delete_$Apache::lonxml::curdepth\">
  264: <option></option>
  265: <option>".&mt('yes')."</option>
  266: </select>";
  267:     return $result;
  268: }
  269: 
  270: sub handle_delete {
  271:     if (!$env{"form.delete_$Apache::lonxml::curdepth"}) { return ''; }
  272:     my ($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  273:     my $result=0;
  274:     if ($space) {
  275: 	my $sub1="$space\:\:delete_$token->[1]";
  276: 	{
  277: 	    no strict 'refs';
  278: 	    if (defined &$sub1) {
  279: 		$result=&$sub1($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  280: 	    }
  281: 	}
  282:     }
  283:     if (!$result) {
  284: 	my $endtag='/'.$token->[1];
  285: 	my $bodytext=&Apache::lonxml::get_all_text($endtag,$parser,$style);
  286: 	$$parser['-1']->get_token();
  287: 	&Apache::lonxml::debug("Deleting :$bodytext: for $token->[1]");
  288: 	&Apache::lonxml::end_tag($tagstack,$parstack,$token);
  289:     }
  290:     return 1;
  291: }
  292: 
  293: sub get_insert_list {
  294:     my ($tagname) = @_;
  295:     my $result='';
  296:     my @tags= ();
  297:     #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist))));
  298:     if ($Apache::lonxml::insertlist{"$tagname.which"}) {
  299: 	push (@tags, @{ $Apache::lonxml::insertlist{"$tagname.which"} });
  300:     }
  301:     foreach my $namespace (@Apache::lonxml::namespace) {
  302: 	if ($Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"}) {
  303: 	    push (@tags, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"} });
  304: 	}
  305:     }
  306:     if (@tags) {
  307: 	my %options;
  308: 	foreach my $tag (@tags) {
  309: 	    my $descrip=$Apache::lonxml::insertlist{"$tag.description"};
  310: 	    my $tagnum =$Apache::lonxml::insertlist{"$tag.num"};
  311: 	    $options{$descrip} ="<option value=\"$tagnum\">".
  312: 		$descrip."</option>\n";
  313: 	}
  314: 	foreach my $option (sort(keys(%options))) {$result.=$options{$option};}
  315: 	if ($result) { $result='<option selected="selected"></option>'.$result; }
  316:     }
  317:     return $result;
  318: }
  319: 
  320: sub insertlist {
  321:     my ($target,$token) = @_;
  322:     return &innerinsertlist($target,$token->[1]);
  323: }
  324: 
  325: sub innerinsertlist {
  326:     my ($target,$tagname,$closingtag) = @_;
  327:     my $result;
  328:     my $after='';
  329:     if ($closingtag) {
  330: 	$after='_after_'.$closingtag; 
  331:     }
  332:     if ($target eq 'edit') {
  333: 	my $optionlist= &get_insert_list($tagname);
  334: 	if ($optionlist) {
  335: 	    $result = &mt('Insert:')."
  336:             <select name=\"insert$after\_$Apache::lonxml::curdepth\">
  337:                   $optionlist
  338:             </select>"
  339: 	} else {
  340: 	    $result="&nbsp;";
  341: 	}
  342:     }
  343:     return $result;
  344: }
  345: 
  346: sub handle_insert {
  347:     if ($env{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; }
  348:     my $tagnum = $env{"form.insert_$Apache::lonxml::curdepth"};
  349:     return &do_insert($tagnum);
  350: }
  351: 
  352: sub handle_insertafter {
  353:     my $tagname=shift;
  354:     if ($env{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"} eq '') {
  355: 	return '';
  356:     }
  357:     my $tagnum =$env{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"};
  358:     return &do_insert($tagnum,1);
  359: }
  360: 
  361: sub do_insert {
  362:     my ($tagnum,$after) = @_;
  363:     my $result;
  364: 
  365:     my $newtag = $Apache::lonxml::insertlist{"$tagnum.tag"};
  366:     my $func   = $Apache::lonxml::insertlist{"$newtag.function"};
  367:     if ($func eq 'default') {
  368: 	my $namespace;
  369: 	if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); }
  370: 	my $depth = scalar(@Apache::lonxml::depthcounter);
  371: 	$depth -- if ($after);
  372: 	my $inset = "\t"x$depth;
  373: 	$result.="\n$inset<$newtag>\n$inset</$newtag>";
  374:     } else {
  375: 	if (defined(&$func)) {
  376: 	    {
  377: 		no strict 'refs';
  378: 		$result.=&$func();
  379: 	    }
  380: 	} else {
  381: 	    &Apache::lonxml::error("Unable to insert tag $newtag, $func was not defined. ($tagnum)");
  382: 	}
  383:     }
  384:     return $result;
  385: }
  386: 
  387: sub insert_img {
  388:     return '
  389:     <img />';
  390: }
  391: 
  392: sub insert_responseparam {
  393:     return '
  394:     <responseparam />';
  395: }
  396: 
  397: sub insert_parameter {
  398:     return '
  399:     <parameter />';
  400: }
  401: 
  402: sub insert_formularesponse {
  403:     return '
  404: <formularesponse answer="" samples="">
  405:     <responseparam description="Numerical Tolerance" type="tolerance" default="0.00001" name="tol" />
  406:     <textline size="25"/>
  407:     <hintgroup>
  408:     <startouttext /><endouttext />
  409:     </hintgroup>
  410: </formularesponse>';
  411: }
  412: 
  413: sub insert_numericalresponse {
  414:     return '
  415: <numericalresponse answer="">
  416: <responseparam type="tolerance" default="5%" name="tol" description="Numerical Tolerance" />
  417: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
  418:     <textline />
  419:     <hintgroup>
  420:     <startouttext /><endouttext />
  421:     </hintgroup>
  422: </numericalresponse>';
  423: }
  424: 
  425: sub insert_customresponse {
  426:     return '
  427: <customresponse>
  428:     <answer type="loncapa/perl">
  429:     </answer>
  430:     <textline />
  431:     <hintgroup>
  432:     <startouttext /><endouttext />
  433:     </hintgroup>
  434: </customresponse>';
  435: }
  436: 
  437: sub insert_customresponse_answer {
  438:     return '
  439:     <answer type="loncapa/perl">
  440:     </answer>
  441: ';
  442: }
  443: 
  444: sub insert_customhint {
  445:     return '
  446:         <customhint>
  447:             <answer type="loncapa/perl">
  448:             </answer>
  449:         </customhint>';
  450: }
  451: 
  452: sub insert_customhint_answer {
  453:     return '
  454:             <answer type="loncapa/perl">
  455:             </answer>
  456: ';
  457: }
  458: 
  459: sub insert_mathresponse {
  460:     return '
  461: <mathresponse>
  462:     <answer>
  463:     </answer>
  464:     <textline />
  465:     <hintgroup>
  466:         <startouttext />
  467:         <endouttext />
  468:     </hintgroup>
  469: </mathresponse>';
  470: }
  471: 
  472: sub insert_mathresponse_answer {
  473:     return '
  474:     <answer>
  475:     </answer>
  476: ';
  477: }
  478: 
  479: sub insert_mathhint {
  480:     return '
  481:         <mathhint>
  482:             <answer>
  483:             </answer>
  484:         </mathhint>';
  485: }
  486: 
  487: sub insert_mathhint_answer {
  488:     return '
  489:             <answer>
  490:             </answer>
  491: ';
  492: }
  493: 
  494: sub insert_stringresponse {
  495:     return '
  496: <stringresponse answer="" type="">
  497:     <textline />
  498:     <hintgroup>
  499:     <startouttext /><endouttext />
  500:     </hintgroup>
  501: </stringresponse>';
  502: }
  503: 
  504: sub insert_essayresponse {
  505:     return '
  506: <essayresponse>
  507:     <textfield></textfield>
  508: </essayresponse>';
  509: }
  510: 
  511: sub insert_imageresponse {
  512:     return '
  513: <imageresponse max="1">
  514:     <foilgroup>
  515:       <foil>
  516:       </foil>
  517:     </foilgroup>
  518:     <hintgroup>
  519:     <startouttext /><endouttext />
  520:     </hintgroup>
  521: </imageresponse>';
  522: }
  523: 
  524: sub insert_optionresponse {
  525:     return '
  526: <optionresponse max="10">
  527:     <foilgroup options="">
  528:       <foil>
  529:          <startouttext /><endouttext />
  530:       </foil>
  531:     </foilgroup>
  532:     <hintgroup>
  533:     <startouttext /><endouttext />
  534:     </hintgroup>
  535: </optionresponse>';
  536: }
  537: 
  538: sub insert_organicresponse {
  539:     return '
  540: <organicresponse>
  541:     <textline />
  542:     <hintgroup>
  543:     <startouttext /><endouttext />
  544:     </hintgroup>
  545: </organicresponse>';
  546: }
  547: 
  548: sub insert_organicstructure {
  549:     return '
  550: <organicstructure />
  551: ';
  552: }
  553: 
  554: sub insert_radiobuttonresponse {
  555:     return '
  556: <radiobuttonresponse max="10">
  557:     <foilgroup>
  558:       <foil>
  559:          <startouttext /><endouttext />
  560:       </foil>
  561:     </foilgroup>
  562:     <hintgroup>
  563:     <startouttext /><endouttext />
  564:     </hintgroup>
  565: </radiobuttonresponse>';
  566: }
  567: 
  568: sub insert_reactionresponse {
  569:     return '
  570: <reactionresponse>
  571:     <textline />
  572:     <hintgroup>
  573:     <startouttext /><endouttext />
  574:     </hintgroup>
  575: </reactionresponse>';
  576: }
  577: 
  578: sub insert_rankresponse {
  579:     return '
  580: <rankresponse max="10">
  581:     <foilgroup options="">
  582:       <foil>
  583:          <startouttext /><endouttext />
  584:       </foil>
  585:     </foilgroup>
  586:     <hintgroup>
  587:     <startouttext /><endouttext />
  588:     </hintgroup>
  589: </rankresponse>';
  590: }
  591: 
  592: sub insert_matchresponse {
  593:     return '
  594: <matchresponse max="10">
  595:     <foilgroup options="">
  596:       <itemgroup>
  597:       </itemgroup>
  598:       <foil>
  599:          <startouttext /><endouttext />
  600:       </foil>
  601:     </foilgroup>
  602:     <hintgroup>
  603:     <startouttext /><endouttext />
  604:     </hintgroup>
  605: </matchresponse>';
  606: }
  607: 
  608: sub insert_displayduedate { return '<displayduedate />'; }
  609: sub insert_displaytitle   { return '<displaytitle />'; }
  610: sub insert_hintpart {
  611:     return '
  612: <hintpart on="default">
  613:     <startouttext/><endouttext />
  614: </hintpart>';
  615: }
  616: 
  617: sub insert_hintgroup {
  618:   return '
  619: <hintgroup>
  620:     <startouttext /><endouttext />
  621: </hintgroup>';
  622: }
  623: 
  624: sub insert_numericalhint {
  625:     return '
  626: <numericalhint>
  627: </numericalhint>';
  628: }
  629: 
  630: sub insert_stringhint {
  631:     return '
  632: <stringhint>
  633: </stringhint>';
  634: }
  635: 
  636: sub insert_formulahint {
  637:     return '
  638: <formulahint>
  639: </formulahint>';
  640: }
  641: 
  642: sub insert_radiobuttonhint {
  643:     return '
  644: <radiobuttonhint>
  645: </radiobuttonhint>';
  646: }
  647: 
  648: sub insert_optionhint {
  649:     return '
  650: <optionhint>
  651: </optionhint>';
  652: }
  653: 
  654: sub insert_startouttext {
  655:     return "<startouttext /><endouttext />";
  656: }
  657: 
  658: sub insert_script {
  659:     return "\n<script type=\"loncapa/perl\"></script>";
  660: }
  661: 
  662: sub js_change_detection {
  663:     my $unsaved=&mt("There are unsaved changes");
  664:     return (<<SCRIPT);
  665: <script type="text/javascript">
  666: var clean = true;
  667: var is_submit = false;
  668: var still_ask = false;
  669: function compareForm(event_) {
  670:         if (!event_ && window.event) {
  671:           event_ = window.event;
  672:         }
  673: 	if ((!is_submit || (is_submit && still_ask)) && !clean) {
  674: 	    still_ask = false;
  675: 	    is_submit = false;
  676:             event_.returnValue = "$unsaved";
  677:             return "$unsaved";
  678:         }
  679: }
  680: function unClean() {
  681:      clean=false;
  682: }
  683: window.onbeforeunload = compareForm;
  684: </script>
  685: SCRIPT
  686: }
  687: 
  688: sub form_change_detection {
  689:     return ' onsubmit="is_submit=true;" ';
  690: }
  691: 
  692: sub element_change_detection {
  693:     return ' onchange="unClean();" ';
  694: }
  695: 
  696: sub submit_ask_anyway {
  697:     my ($extra_action) = @_;
  698:     return ' onclick="still_ask=true;'.$extra_action.'" ';
  699: }
  700: 
  701: sub textarea_sizes {
  702:     my ($data)=@_;
  703:     my $count=0;
  704:     my $maxlength=-1;
  705:     foreach (split ("\n", $$data)) {
  706: 	$count+=int(length($_)/79);
  707: 	$count++;
  708: 	if (length($_) > $maxlength) { $maxlength = length($_); }
  709:     }
  710:     my $rows = $count;
  711:     my $cols = $maxlength;
  712:     return ($rows,$cols);
  713: }
  714: 
  715: sub editline {
  716:     my ($tag,$data,$description,$size)=@_;
  717:     $data=&HTML::Entities::encode($data,'<>&"');
  718:     if ($description) { $description=$description."<br />"; }
  719:     my $change_code = &element_change_detection();
  720:     my $result = <<"END";
  721: $description
  722: <input type="text" name="homework_edit_$Apache::lonxml::curdepth" 
  723:        value="$data" size="$size" $change_code />
  724: END
  725:     return $result;
  726: }
  727: 
  728: sub editfield {
  729:     my ($tag,$data,$description,$minwidth,$minheight,$usehtmlarea)=@_;
  730: 
  731:     my ($rows,$cols)=&textarea_sizes(\$data);
  732:     if (&Apache::lonhtmlcommon::htmlareabrowser() &&
  733: 	!&Apache::lonhtmlcommon::htmlareablocked()) {
  734: 	$rows+=7;      # make room for HTMLarea
  735: 	$minheight+=7; # make room for HTMLarea
  736:     }
  737:     if ($cols > 80) { $cols = 80; }
  738:     if ($cols < $minwidth ) { $cols = $minwidth; }
  739:     if ($rows < $minheight) { $rows = $minheight; }
  740:     if ($description) { $description=$description."<br />"; }
  741:     if ($usehtmlarea) {
  742: 	&Apache::lonhtmlcommon::add_htmlareafields('homework_edit_'.
  743: 						   $Apache::lonxml::curdepth);
  744:     }
  745:     # remove typesetting whitespace from between data and the end tag
  746:     # to make the edit look prettier
  747:     $data =~ s/\n?[ \t]*$//;
  748: 
  749:     return $description."\n".'<textarea style="width:100%" rows="'.$rows.
  750: 	'" cols="'.$cols.'" name="homework_edit_'.
  751: 	$Apache::lonxml::curdepth.'" id="homework_edit_'.
  752: 	$Apache::lonxml::curdepth.'" '.&element_change_detection().'>'.
  753: 	&HTML::Entities::encode($data,'<>&"').'</textarea>'.
  754: 	($usehtmlarea?&Apache::lonhtmlcommon::spelllink('lonhomework',
  755: 			 'homework_edit_'.$Apache::lonxml::curdepth):'')."\n";
  756: }
  757: 
  758: sub modifiedfield {
  759:     my ($endtag,$parser) = @_;
  760:     my $result;
  761:     $result=$env{"form.homework_edit_$Apache::lonxml::curdepth"};
  762:     my $bodytext=&Apache::lonxml::get_all_text($endtag,$parser);
  763:     # textareas throw away intial \n 
  764:     if ($bodytext=~/^\n/) {
  765: 	$result="\n".$result;
  766:     }
  767:     # if there is typesetting whitespace from between the data and the end tag
  768:     # restore to keep the source looking pretty
  769:     if ($bodytext =~ /(\n?[ \t]*)$/) {
  770: 	$result .= $1;
  771:     }
  772:     return $result;
  773: }
  774: 
  775: # Returns a 1 if the token has been modified and you should rebuild the tag
  776: # side-effects, will modify the $token if new values are found
  777: sub get_new_args {
  778:     my ($token,$parstack,$safeeval,@args)=@_;
  779:     my $rebuild=0;
  780:     foreach my $arg (@args) {
  781: 	#just want the string that it was set to
  782: 	my $value=$token->[2]->{$arg};
  783: 	my $element=&html_element_name($arg);
  784: 	my $newvalue=$env{"form.$element"};
  785: 	&Apache::lonxml::debug("for:$arg: cur is :$value: new is :$newvalue:");
  786: 	if (defined($newvalue) && $value ne $newvalue) {
  787: 	    if (ref($newvalue) eq 'ARRAY') {
  788: 		$token->[2]->{$arg}=join(',',@$newvalue);
  789: 	    } else {
  790: 		$token->[2]->{$arg}=$newvalue;
  791: 	    }
  792: 	    $rebuild=1;
  793: 	    # add new attributes to the of the attribute seq
  794: 	    if (!grep { $arg eq $_ } (@{ $token->[3] })) {
  795: 		push(@{ $token->[3] },$arg);
  796: 	    }
  797: 	} elsif (!defined($newvalue) && defined($value)) {
  798: 	    delete($token->[2]->{$arg});
  799: 	    $rebuild=1;
  800: 	}
  801:     }
  802:     return $rebuild;
  803: }
  804: 
  805: # looks for /> on start tags
  806: sub rebuild_tag {
  807:     my ($token) = @_;
  808:     my $result;
  809:     if ($token->[0] eq 'S') {
  810: 	$result = '<'.$token->[1];
  811: 	foreach my $attribute (@{ $token->[3] }) {
  812: 	    my $value = $token->[2]{$attribute};
  813: 	    next if ($value eq '');
  814: 	    $value =~s/^\s+|\s+$//g;
  815: 	    $value =~s/\"//g;
  816: 	    &Apache::lonxml::debug("setting :$attribute: to  :$value:");
  817: 	    $result.=' '.$attribute.'="'.$value.'"';
  818: 	}
  819: 	if ($token->[4] =~ m:/>$:) {
  820: 	    $result.=' />';
  821: 	} else {
  822: 	    $result.='>';
  823: 	}
  824:     } elsif ( $token->[0] eq 'E' ) {
  825: 	$result = '</'.$token->[1].'>';
  826:     }
  827:     return $result;
  828: }
  829: 
  830: sub html_element_name {
  831:     my ($name) = @_;
  832:     return $name.'_'.$Apache::lonxml::curdepth;
  833: }
  834: 
  835: sub hidden_arg {
  836:     my ($name,$token) = @_;
  837:     my $result;
  838:     my $arg=$token->[2]{$name};
  839:     $result='<input name="'.&html_element_name($name).
  840: 	'" type="hidden" value="'.$arg.'" />';
  841:     return $result;
  842: }
  843: 
  844: sub checked_arg {
  845:     my ($description,$name,$list,$token) = @_;
  846:     my $result;
  847:     my $optionlist="";
  848:     my $allselected=$token->[2]{$name};
  849:     $result=&mt($description);
  850:     foreach my $option (@$list) {
  851: 	my ($value,$text);
  852: 	if ( ref($option) eq 'ARRAY') {
  853: 	    $value='value="'.$$option[0].'"';
  854: 	    $text=$$option[1];
  855: 	    $option=$$option[0];
  856: 	} else {
  857: 	    $text=$option;
  858: 	    $value='value="'.$option.'"';
  859: 	}
  860: 	$result.="<nobr><label><input type=\"checkbox\" $value name=\"".
  861: 	    &html_element_name($name)."\"";
  862: 	foreach my $selected (split(/,/,$allselected)) {
  863: 	    if ( $selected eq $option ) {
  864: 		$result.=" checked=\"checked\" ";
  865: 		last;
  866: 	    }
  867: 	}
  868: 	$result.=&element_change_detection()." />$text</label></nobr>\n";
  869:     }
  870:     return $result;
  871: }
  872: 
  873: sub text_arg {
  874:     my ($description,$name,$token,$size) = @_;
  875:     my $result;
  876:     if (!defined $size) { $size=20; }
  877:     my $arg=$token->[2]{$name};
  878:     $result=&mt($description).'&nbsp;<input name="'.&html_element_name($name).
  879: 	'" type="text" value="'.$arg.'" size="'.$size.'" '.
  880: 	&element_change_detection().'/>';
  881:     return '<nobr>'.$result.'</nobr>';
  882: }
  883: 
  884: sub select_arg {
  885:     my ($description,$name,$list,$token) = @_;
  886:     my $result;
  887:     my $optionlist="";
  888:     my $selected=$token->[2]{$name};
  889:     foreach my $option (@$list) {
  890: 	my ($text,$value);
  891: 	if ( ref($option) eq 'ARRAY') {
  892: 	    $value='value="'.&HTML::Entities::encode($$option[0]).'"';
  893: 	    $text=$$option[1];
  894: 	    $option=$$option[0];
  895: 	} else {
  896: 	    $text=$option;
  897: 	    $value='value="'.&HTML::Entities::encode($option,'\'"&<>').'"';
  898: 	}
  899: 	if ( $selected eq $option ) {
  900: 	    $optionlist.="<option $value selected=\"selected\">".&mt($text)."</option>\n";
  901: 	} else {
  902: 	    $optionlist.="<option $value >".&mt($text)."</option>\n";
  903: 	}
  904:     }
  905:     $result.='<nobr>'.&mt($description).'&nbsp;<select name="'.
  906: 	&html_element_name($name).'" '.&element_change_detection().' >
  907:        '.$optionlist.'
  908:       </select></nobr>';
  909:     return $result;
  910: }
  911: 
  912: sub select_or_text_arg {
  913:     my ($description,$name,$list,$token,$size) = @_;
  914:     my $result;
  915:     my $optionlist="";
  916:     my $found=0;
  917:     my $selected=$token->[2]{$name};
  918:     foreach my $option (@$list) {
  919: 	my ($text,$value);
  920: 	if ( ref($option) eq 'ARRAY') {
  921: 	    $value='value="'.&HTML::Entities::encode($$option[0]).'"';
  922: 	    $text=$$option[1];
  923: 	    $option=$$option[0];
  924: 	} else {
  925: 	    $text=$option;
  926: 	    $value='value="'.&HTML::Entities::encode($option,'\'"&<>').'"';
  927: 	}
  928: 	if ( $selected eq $option ) {
  929: 	    $optionlist.="<option $value selected=\"selected\">$text</option>\n";
  930: 	    $found=1;
  931: 	} else {
  932: 	    $optionlist.="<option $value>$text</option>\n";
  933: 	}
  934:     }
  935:     $optionlist.="<option value=\"TYPEDINVALUE\"".
  936:  	((!$found)?' selected="selected"':'').
  937:  	">".&mt('Type-in value')."</option>\n";
  938: #
  939:     my $change_code=&element_change_detection();
  940:     my $element=&html_element_name($name);
  941:     my $selectelement='select_list_'.$element;
  942:     my $typeinelement='type_in_'.$element;
  943:     my $typeinvalue=($found?'':$selected);
  944: #
  945:     my $hiddenvalue='this.form.'.$element.'.value';
  946:     my $selectedindex='this.form.'.$selectelement.'.selectedIndex';
  947:     my $selectedvalue='this.form.'.$selectelement.
  948: 	     '.options['.$selectedindex.'].value';
  949:     my $typedinvalue='this.form.'.$typeinelement.'.value';
  950:     my $selecttypeinindex='this.form.'.$selectelement.'.options.length';
  951:     $description=&mt($description);
  952: #
  953:     return (<<ENDSELECTORTYPE);
  954: <nobr>
  955: $description
  956: &nbsp;<select name="$selectelement"
  957: onChange="if ($selectedvalue!='TYPEDINVALUE') { $hiddenvalue=$selectedvalue; $typedinvalue=''; }" >
  958: $optionlist
  959: </select>
  960: <input type="text" size="$size" name="$typeinelement"
  961:        value="$typeinvalue" 
  962: onChange="$hiddenvalue=$typedinvalue;"
  963: onFocus="$selectedindex=$selecttypeinindex-1;" />
  964: <input type="hidden" name="$element" value="$selected" $change_code />
  965: </nobr>
  966: ENDSELECTORTYPE
  967: }
  968: 
  969: #----------------------------------------------------- image coordinates
  970: # single image coordinates, x, y 
  971: sub entercoords {
  972:     my ($idx,$idy,$mode,$width,$height) = @_;
  973:     unless ($Apache::edit::bgimgsrc) { return ''; }
  974:     if ($idx) { $idx.='_'; }
  975:     if ($idy) { $idy.='_'; }
  976:     my $bgfile=&escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc));
  977:     my $form    = 'lonhomework';
  978:     my $element;
  979:     if (! defined($mode) || $mode eq 'attribute') {
  980:         $element = &escape("$Apache::lonxml::curdepth");
  981:     } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
  982:         $element = &escape('homework_edit_'.
  983:                                            $Apache::lonxml::curdepth);
  984:     }
  985:     my $id=$Apache::lonxml::curdepth;
  986:     my %data=("imagechoice.$id.type"      =>'point',
  987: 	      "imagechoice.$id.formname"  =>$form,
  988: 	      "imagechoice.$id.formx"     =>"$idx$element",
  989: 	      "imagechoice.$id.formy"     =>"$idy$element",
  990: 	      "imagechoice.$id.file"      =>$bgfile,
  991: 	      "imagechoice.$id.formcoord" =>$element);
  992:     if ($height) {
  993: 	$data{"imagechoice.$id.formheight"}=$height.'_'.
  994: 	    $Apache::edit::bgimgsrccurdepth;
  995:     }
  996:     if ($width) {
  997: 	$data{"imagechoice.$id.formwidth"}=$width.'_'.
  998: 	    $Apache::edit::bgimgsrccurdepth;
  999:     }
 1000:     &Apache::lonnet::appenv(\%data);
 1001:     my $text="Click Coordinates";
 1002:     my $result='<a href="/adm/imagechoice?token='.$id.'" target="imagechoice">'.$text.'</a>';
 1003:     return $result;
 1004: }
 1005: 
 1006: # coordinates (x1,y1)-(x2,y2)...
 1007: # mode can be either box, or polygon
 1008: sub entercoord {
 1009:     my ($idx,$mode,$width,$height,$type) = @_;
 1010:     unless ($Apache::edit::bgimgsrc) { return ''; }
 1011:     my $bgfile=&escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc));
 1012:     my $form    = 'lonhomework';
 1013:     my $element;
 1014:     if (! defined($mode) || $mode eq 'attribute') {
 1015:         $element = &escape("$idx\_$Apache::lonxml::curdepth");
 1016:     } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
 1017:         $element = &escape('homework_edit_'.
 1018:                                            $Apache::lonxml::curdepth);
 1019:     }
 1020:     my $id=$Apache::lonxml::curdepth;
 1021:     my %data=("imagechoice.$id.type"      =>$type,
 1022: 	      "imagechoice.$id.formname"  =>$form,
 1023: 	      "imagechoice.$id.file"      =>$bgfile,
 1024: 	      "imagechoice.$id.formcoord" =>$element);
 1025:     if ($height) {
 1026: 	$data{"imagechoice.$id.formheight"}=$height.'_'.
 1027: 	    $Apache::edit::bgimgsrccurdepth;
 1028:     }
 1029:     if ($width) {
 1030: 	$data{"imagechoice.$id.formwidth"}=$width.'_'.
 1031: 	    $Apache::edit::bgimgsrccurdepth;
 1032:     }
 1033:     &Apache::lonnet::appenv(\%data);
 1034:     my $text="Enter Coordinates";
 1035:     if ($type eq 'polygon') { $text='Create Polygon Data'; }
 1036:     my $result='<a href="/adm/imagechoice?token='.$id.'" target="imagechoice">'.$text.'</a>';
 1037:     return $result;
 1038: }
 1039: 
 1040: sub deletecoorddata {
 1041:     &Apache::lonnet::delenv("imagechoice\\.");
 1042: }
 1043: 
 1044: #----------------------------------------------------- browse
 1045: sub browse {
 1046:     # insert a link to call up the filesystem browser (lonindexer)
 1047:     my ($id, $mode, $titleid, $only) = @_;
 1048:     my $form    = 'lonhomework';
 1049:     my $element;
 1050:     if (! defined($mode) || $mode eq 'attribute') {
 1051:         $element = &escape("$id\_$Apache::lonxml::curdepth");
 1052:     } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
 1053:         $element = &escape('homework_edit_'.
 1054:                                            $Apache::lonxml::curdepth);	
 1055:     }
 1056:     my $titleelement;
 1057:     if ($titleid) {
 1058: 	$titleelement=",'$only','','".&escape("$titleid\_$Apache::lonxml::curdepth")."'";
 1059:     } else {
 1060:         $titleelement=",'$only'";
 1061:     }
 1062:     my $result = <<"ENDBUTTON";
 1063: <a href=\"javascript:openbrowser('$form','$element'$titleelement)\"\>Select</a>
 1064: ENDBUTTON
 1065:     return $result;
 1066: }
 1067: 
 1068: #----------------------------------------------------- browse
 1069: sub search {
 1070:     # insert a link to call up the filesystem browser (lonindexer)
 1071:     my ($id, $mode, $titleid) = @_;
 1072:     my $form    = 'lonhomework';
 1073:     my $element;
 1074:     if (! defined($mode) || $mode eq 'attribute') {
 1075:         $element = &escape("$id\_$Apache::lonxml::curdepth");
 1076:     } elsif ($mode eq 'textnode') {  # for data between <tag> ... </tag>
 1077:         $element = &escape('homework_edit_'.
 1078:                                            $Apache::lonxml::curdepth);
 1079:     }
 1080:     my $titleelement;
 1081:     if ($titleid) {
 1082: 	$titleelement=",'".&escape("$titleid\_$Apache::lonxml::curdepth")."'";
 1083:     }
 1084:     my $result = <<"ENDBUTTON";
 1085: <a href=\"javascript:opensearcher('$form','$element'$titleelement)\"\>Search</a>
 1086: ENDBUTTON
 1087:     return $result;
 1088: }
 1089: 
 1090: 
 1091: 1;
 1092: __END__
 1093: 
 1094: 

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