--- loncom/homework/edit.pm 2001/05/15 20:48:43 1.7 +++ loncom/homework/edit.pm 2011/08/09 16:12:21 1.135 @@ -1,149 +1,1147 @@ # The LearningOnline Network with CAPA # edit mode helpers -# 3/20 Guy +# +# $Id: edit.pm,v 1.135 2011/08/09 16:12:21 bisitz Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# + +=pod + +=head1 NAME + +Apache::edit - edit mode helpers + +=head1 SYNOPSIS + +Invoked by many homework and xml related modules. + + &Apache::edit::SUBROUTINENAME(ARGUMENTS); + +=head1 INTRODUCTION + +This module outputs HTML syntax helpful for the rendering of edit +mode interfaces. + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 SUBROUTINES + +=over 4 + +=item initialize_edit() + +initialize edit (set colordepth to zero) + +=item tag_start($target,$token,$description) + +provide deletion and insertion lists +for the manipulation of a start tag; return a scalar string + +=item tag_end($target,$token,$description) + +ending syntax corresponding to +&tag_start. return a scalar string. + +=item start_table($token) + +start table; update colordepth; return scalar string. + +=item end_table() + +reduce color depth; end table; return scalar string + +=item start_spanning_row() + +start a new table row spanning the 'edit' environment. + +=item start_row() + +start a new table row and element. + +=item end_row() + +end current table element and row. + +=item movebuttons($target,$token) + +move-up and move-down buttons; return scalar string + +=item deletelist($target,$token) + +provide a yes option in an HTML select element; return scalar string + +=item handle_delete($space,$target,$token,$tagstack,$parstack,$parser,$safeeval, +$style) + +respond to a user delete request by passing relevant stack +and array information to various rendering functions; return a scalar string + +=item get_insert_list($token) + +provide an insertion list based on possibilities from lonxml; return a scalar string + +=item insertlist($target,$token) + +api that uses get_insert_list; return a scalar string + +=item handleinsert($token) + +provide an insertion list based on possibilities from lonxml; return a scalar string + +=item get_insert_list($token) + +provide an insertion list based on possibilities from lonxml; return a scalar string + +=item browse($elementname) + +provide a link which will open up the filesystem browser (lonindexer) and, once a file is selected, place the result in the form element $elementname. + +=item search($elementname) + +provide a link which will open up the filesystem searcher (lonsearchcat) and, once a file is selected, place the result in the form element $elementname. + +=item editline(tag,data,description,size) + +Provide a for single-line text entry. This is to be used for text enclosed by tags, not arguements/parameters associated with a tag. + +=back + +=cut + package Apache::edit; use strict; use Apache::lonnet; +use HTML::Entities(); +use Apache::lonlocal; +use lib '/home/httpd/lib/perl/'; +use LONCAPA; + + +# Global Vars +# default list of colors to use in editing +@Apache::edit::colorlist=('#ffffff','#ff0000','#00ff00','#0000ff','#0ff000','#000ff0','#f0000f'); +# depth of nesting of edit +$Apache::edit::colordepth=0; +@Apache::edit::inserttag=(); +# image-type responses: active background image and curdepth at definition +$Apache::edit::bgimgsrc=''; +$Apache::edit::bgimgsrccurdepth=''; + +sub initialize_edit { + $Apache::edit::colordepth=0; + @Apache::edit::inserttag=(); +} sub tag_start { - my ($target,$token) = @_; - my $result=''; - if ($target eq "edit") { - my $tag=$token->[1]; -# my $color = sprintf("#%06lx",(hex("ffffff")) >> scalar(split(/_/,$Apache::lonxml::curdepth))); - my $color = sprintf("#%02lxffff",33* scalar(split(/_/,$Apache::lonxml::curdepth))); - $result.=" - - - + +
<$tag>Delete: -". - &insertlist($token,$target). - "
\n"; - } - return $result; + my ($target,$token,$description) = @_; + my $result=''; + if ($target eq "edit") { + my $tag=$token->[1]; + if (!$description) { + $description=&Apache::lonxml::description($token); + if (!$description) { $description="<$tag>"; } + } + $result.= &start_table($token)."
$description".&mt('Delete?').' '. + &deletelist($target,$token) + ."". + &insertlist($target,$token); +#". +# &movebuttons($target,$token). +# "
\n"; + my @help = Apache::lonxml::helpinfo($token); + if ($help[0]) { + $result .= '' . + Apache::loncommon::help_open_topic(@help); + } else { $result .= " "; } + $result .= &end_row().&start_spanning_row(); + } + return $result; } sub tag_end { - my ($target,$token) = @_; - my $result=''; - if ($target eq 'edit') { - my $tag=$token->[1]; - $result.="
</$tag>
\n"; - } - return $result; + my ($target,$token,$description) = @_; + my $result=''; + if ($target eq 'edit') { + $result.="".&end_table()."\n"; + } + return $result; +} + +sub start_table { + my ($token)=@_; + my $tag = &Apache::lonxml::get_tag($token); + + my $color = $Apache::lonxml::insertlist{"$tag.color"}; + &Apache::lonxml::debug(" $tag -- $color"); + if (!defined($color)) { + $color = $Apache::edit::colorlist[$Apache::edit::colordepth]; + } + $Apache::edit::colordepth++; + push(@Apache::edit::inserttag,$token->[1]); + my $result='
'; + $result.=''; + return $result; +} + +sub end_table { + $Apache::edit::colordepth--; + my $result='
'; + $result.='
'; + + my ($tagname,$closingtag); + if (defined($Apache::edit::inserttag[-2])) { + $tagname=$Apache::edit::inserttag[-2]; + } else { + if ($Apache::lonhomework::parsing_a_task) { + $tagname='Task'; + } else { + $tagname='problem'; + } + } + if (defined($Apache::edit::inserttag[-1])) { + $closingtag=$Apache::edit::inserttag[-1]; + } + $result.=&innerinsertlist('edit',$tagname,$closingtag). + "
"; + my $last = pop(@Apache::edit::inserttag); + return $result; +} + +sub start_spanning_row { return '';} +sub start_row { return ''; } +sub end_row { return ''; } + +sub movebuttons { + my ($target,$token) = @_; + my $result=''; + $result.=''; + return $result; +} + +sub deletelist { + my ($target,$token) = @_; + my $result = ""; + return $result; +} + +sub handle_delete { + if (!$env{"form.delete_$Apache::lonxml::curdepth"}) { return ''; } + my ($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $result=0; + if ($space) { + my $sub1="$space\:\:delete_$token->[1]"; + { + no strict 'refs'; + if (defined &$sub1) { + $result=&$sub1($target,$token,$tagstack,$parstack,$parser,$safeeval,$style); + } + } + } + if (!$result) { + my $endtag='/'.$token->[1]; + my $bodytext=&Apache::lonxml::get_all_text($endtag,$parser,$style); + $$parser['-1']->get_token(); + &Apache::lonxml::debug("Deleting :$bodytext: for $token->[1]"); + &Apache::lonxml::end_tag($tagstack,$parstack,$token); + } + return 1; } sub get_insert_list { - my ($token) = @_; - my $result=''; - my @tagnums= (); - #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist)))); - if ($Apache::lonxml::insertlist{"$token->[1].which"}) { - &Apache::lonxml::debug("Adding1 $token->[1].which"); - push (@tagnums, @{ $Apache::lonxml::insertlist{"$token->[1].which"} }); - } - foreach my $namespace (@Apache::lonxml::namespace) { - if ($Apache::lonxml::insertlist{"$namespace".'::'."$token->[1].which"}) { - &Apache::lonxml::debug("Adding2 $namespace".'::'."$token->[1].which"); - push (@tagnums, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$token->[1].which"} }); - } - } - if (@tagnums) { - foreach my $tagnum (@tagnums) { - $result.='\n"; - } - if ($result) { $result=''.$result; } - } - return $result; + my ($tagname) = @_; + my $result=''; + my @tags= (); + #&Apache::lonxml::debug("keys ".join("\n",sort(keys(%Apache::lonxml::insertlist)))); + if ($Apache::lonxml::insertlist{"$tagname.which"}) { + push (@tags, @{ $Apache::lonxml::insertlist{"$tagname.which"} }); + } + foreach my $namespace (@Apache::lonxml::namespace) { + if ($Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"}) { + push (@tags, @{ $Apache::lonxml::insertlist{"$namespace".'::'."$tagname.which"} }); + } + } + if (@tags) { + my %options; + foreach my $tag (@tags) { + my $descrip=$Apache::lonxml::insertlist{"$tag.description"}; + my $tagnum =$Apache::lonxml::insertlist{"$tag.num"}; + $options{$descrip} ="\n"; + } + foreach my $option (sort(keys(%options))) {$result.=$options{$option};} + if ($result) { $result=''.$result; } + } + return $result; } sub insertlist { - my ($token,$target) = @_; - my $result; - if ($target eq 'edit') { - my $optionlist= &get_insert_list($token); - if ($optionlist) { - $result = "Insert: -" + my ($target,$token) = @_; + return &innerinsertlist($target,$token->[1]); +} + +sub innerinsertlist { + my ($target,$tagname,$closingtag) = @_; + my $result; + my $after=''; + if ($closingtag) { + $after='_after_'.$closingtag; + } + if ($target eq 'edit') { + my $optionlist= &get_insert_list($tagname); + if ($optionlist) { + $result = &mt('Insert:')." + " + } else { + $result=" "; + } } - } - return $result; + return $result; } sub handle_insert { - if (!$ENV{"form.insert_$Apache::lonxml::curdepth"}) { return ''; } - my $result; - my $tagnum = $ENV{"form.insert_$Apache::lonxml::curdepth"}; - my $func=$Apache::lonxml::insertlist{"$tagnum.function"}; - if ($func eq 'default') { - my $newtag=$Apache::lonxml::insertlist{"$tagnum.tag"}; - my $namespace; - if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); } - $result.="\n<$newtag>\n"; - } else { - { - no strict 'refs'; - $result.=&$func(); + if ($env{"form.insert_$Apache::lonxml::curdepth"} eq '') { return ''; } + my $tagnum = $env{"form.insert_$Apache::lonxml::curdepth"}; + return &do_insert($tagnum); +} + +sub handle_insertafter { + my $tagname=shift; + if ($env{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"} eq '') { + return ''; } - } - return $result; + my $tagnum =$env{"form.insert_after_$tagname\_$Apache::lonxml::curdepth"}; + return &do_insert($tagnum,1); +} + +sub do_insert { + my ($tagnum,$after) = @_; + my $result; + + my $newtag = $Apache::lonxml::insertlist{"$tagnum.tag"}; + my $func = $Apache::lonxml::insertlist{"$newtag.function"}; + if ($func eq 'default') { + my $namespace; + if ($newtag =~ /::/) { ($namespace,$newtag) = split(/::/,$newtag); } + my $depth = scalar(@Apache::lonxml::depthcounter); + $depth -- if ($after); + my $inset = "\t"x$depth; + $result.="\n$inset<$newtag>"; + } else { + if (defined(&$func)) { + { + no strict 'refs'; + $result.=&$func(); + } + } else { + &Apache::lonxml::error("Unable to insert tag $newtag, $func was not defined. ($tagnum)"); + } + } + return $result; +} + +sub insert_img { + return ' + '; +} + +sub insert_responseparam { + return ' + '; +} + +sub insert_parameter { + return ' + '; +} + +sub insert_formularesponse { + return ' + + + + + + +'; +} + +sub insert_functionplotresponse { + return ' + + + + + + + +'; +} + +sub insert_spline { + return ' +'; +} + +sub insert_backgroundplot { + return ' +'; +} + +sub insert_functionplotrule { + return ' +'; +} + +sub insert_functionplotruleset { + return ' + + +'; +} + +sub insert_functionplotelements { + return ' + + +'; +} + +sub insert_numericalresponse { + return ' + + + + + + + +'; +} + +sub insert_customresponse { + return ' + + + + + + + +'; +} + +sub insert_customresponse_answer { + return ' + + +'; +} + +sub insert_customhint { + return ' + + + + '; +} + +sub insert_customhint_answer { + return ' + + +'; +} + +sub insert_mathresponse { + return ' + + + + + + + + +'; +} + +sub insert_mathresponse_answer { + return ' + + +'; +} + +sub insert_mathhint { + return ' + + + + '; +} + +sub insert_mathhint_answer { + return ' + + +'; +} + +sub insert_stringresponse { + return ' + + + + + +'; +} + +sub insert_essayresponse { + return ' + + +'; +} + +sub insert_imageresponse { + return ' + + + + + + + + +'; } sub insert_optionresponse { - return ' + return ' + + + + + + '; } +sub insert_organicresponse { + return ' + + + + + +'; +} + +sub insert_organicstructure { + return ' + +'; +} + +sub insert_radiobuttonresponse { + return ' + + + + + + + + + +'; +} + +sub insert_reactionresponse { + return ' + + + + + +'; +} + +sub insert_rankresponse { + return ' + + + + + + + + + +'; +} + +sub insert_matchresponse { + return ' + + + + + + + + + + + +'; +} + +sub insert_startpartmarker { return ''; } +sub insert_endpartmarker { return ''; } + +sub insert_displayduedate { return ''; } +sub insert_displaytitle { return ''; } +sub insert_hintpart { + return ' + + +'; +} + +sub insert_hintgroup { + return ' + + +'; +} + +sub insert_numericalhint { + return ' + +'; +} + +sub insert_reactionhint { + return ' + +'; +} + +sub insert_organichint { + return ' + +'; +} + +sub insert_stringhint { + return ' + +'; +} + +sub insert_formulahint { + return ' + +'; +} + +sub insert_radiobuttonhint { + return ' + +'; +} + +sub insert_optionhint { + return ' + +'; +} + +sub insert_startouttext { + return ""; +} + +sub insert_script { + return "\n"; +} + +sub js_change_detection { + my $unsaved=&mt("There are unsaved changes"); + return (< +var clean = true; +var is_submit = false; +var still_ask = false; +function compareForm(event_) { + if (!event_ && window.event) { + event_ = window.event; + } + if ((!is_submit || (is_submit && still_ask)) && !clean) { + still_ask = false; + is_submit = false; + event_.returnValue = "$unsaved"; + return "$unsaved"; + } +} +function unClean() { + clean=false; +} +window.onbeforeunload = compareForm; + +SCRIPT +} + +sub form_change_detection { + return ' onsubmit="is_submit=true;" '; +} + +sub element_change_detection { + return ' onchange="unClean();" '; +} + +sub submit_ask_anyway { + my ($extra_action) = @_; + return ' onclick="still_ask=true;'.$extra_action.'" '; +} + +sub submit_dont_ask { + my ($extra_action) = @_; + return ' onclick="is_submit=true;'.$extra_action.'" '; +} + + +sub textarea_sizes { + my ($data)=@_; + my $count=0; + my $maxlength=-1; + foreach (split ("\n", $$data)) { + $count+=int(length($_)/79); + $count++; + if (length($_) > $maxlength) { $maxlength = length($_); } + } + my $rows = $count; + my $cols = $maxlength; + return ($rows,$cols); +} + +sub editline { + my ($tag,$data,$description,$size)=@_; + $data=&HTML::Entities::encode($data,'<>&"'); + if ($description) { $description=$description."
"; } + my $change_code = &element_change_detection(); + my $result = <<"END"; +$description + +END + return $result; +} + sub editfield { - my ($tag,$data,$description,$minwidth,$minheight)=@_; - - my $count=0; - my $maxlength=-1; - map { $count++; - if (length($_) > $maxlength) { $maxlength = length ($_); } - } split ("\n", $data); - if ($maxlength > 80) { $maxlength = 80; } - if ($maxlength < $minwidth) { $maxlength = $minwidth; } - if ( $count < $minheight) { $count = $minheight; } - if ($description) { - $description="
".$description; - } - return "$description
\n   \n"; -# return "
\n<$tag>
\n   
\n</$tag>
\n"; + my ($tag,$data,$description,$minwidth,$minheight,$usehtmlarea)=@_; + + my ($rows,$cols)=&textarea_sizes(\$data); + my $textareaclass; + + if (&Apache::lonhtmlcommon::htmlareabrowser() && $usehtmlarea) { + $rows+=7; # make room for HTMLarea + $minheight+=7; # make room for HTMLarea + $textareaclass = ' class="LC_richDefaultOff"'; + } + if ($cols > 80) { $cols = 80; } + if ($cols < $minwidth ) { $cols = $minwidth; } + if ($rows < $minheight) { $rows = $minheight; } + if ($description) { $description=$description."
"; } + + # remove typesetting whitespace from between data and the end tag + # to make the edit look prettier + $data =~ s/\n?[ \t]*$//; + + return $description."\n".''. + ($usehtmlarea?&Apache::lonhtmlcommon::spelllink('lonhomework', + 'homework_edit_'.$Apache::lonxml::curdepth):'')."\n"; } sub modifiedfield { - my ($token) = @_; - my $result; -# foreach my $envkey (sort keys %ENV) { -# &Apache::lonxml::debug("$envkey ---- $ENV{$envkey}"); -# } -# &Apache::lonxml::debug("I want homework_edit_$Apache::lonxml::curdepth"); -# &Apache::lonxml::debug($ENV{"form.homework_edit_$Apache::lonxml::curdepth"}); - $result=$ENV{"form.homework_edit_$Apache::lonxml::curdepth"}; - if (defined $token) { - if (defined $token->[4]) { - $result=$token->[4].$result; + my ($endtag,$parser) = @_; + my $result; + $result=$env{"form.homework_edit_$Apache::lonxml::curdepth"}; + my $bodytext=&Apache::lonxml::get_all_text($endtag,$parser); + # textareas throw away intial \n + if ($bodytext=~/^\n/) { + $result="\n".$result; + } + # if there is typesetting whitespace from between the data and the end tag + # restore to keep the source looking pretty + if ($bodytext =~ /(\n?[ \t]*)$/) { + $result .= $1; + } + return $result; +} + +# Returns a 1 if the token has been modified and you should rebuild the tag +# side-effects, will modify the $token if new values are found +sub get_new_args { + my ($token,$parstack,$safeeval,@args)=@_; + my $rebuild=0; + foreach my $arg (@args) { + #just want the string that it was set to + my $value=$token->[2]->{$arg}; + my $element=&html_element_name($arg); + my $newvalue=$env{"form.$element"}; + &Apache::lonxml::debug("for:$arg: cur is :$value: new is :$newvalue:"); + if (defined($newvalue) && $value ne $newvalue) { + if (ref($newvalue) eq 'ARRAY') { + $token->[2]->{$arg}=join(',',@$newvalue); + } else { + $token->[2]->{$arg}=$newvalue; + } + $rebuild=1; + # add new attributes to the of the attribute seq + if (!grep { $arg eq $_ } (@{ $token->[3] })) { + push(@{ $token->[3] },$arg); + } + } elsif (!defined($newvalue) && defined($value)) { + delete($token->[2]->{$arg}); + $rebuild=1; + } + } + return $rebuild; +} + +# looks for /> on start tags +sub rebuild_tag { + my ($token) = @_; + my $result; + if ($token->[0] eq 'S') { + $result = '<'.$token->[1]; + foreach my $attribute (@{ $token->[3] }) { + my $value = $token->[2]{$attribute}; + next if ($value eq ''); + $value =~s/^\s+|\s+$//g; + $value =~s/\"//g; + &Apache::lonxml::debug("setting :$attribute: to :$value:"); + $result.=' '.$attribute.'="'.$value.'"'; + } + if ($token->[4] =~ m:/>$:) { + $result.=' />'; + } else { + $result.='>'; + } + } elsif ( $token->[0] eq 'E' ) { + $result = '[1].'>'; + } + return $result; +} + +sub html_element_name { + my ($name) = @_; + return $name.'_'.$Apache::lonxml::curdepth; +} + +sub hidden_arg { + my ($name,$token) = @_; + my $result; + my $arg=$token->[2]{$name}; + $result=''; + return $result; +} + +sub checked_arg { + my ($description,$name,$list,$token) = @_; + my $result; + my $optionlist=""; + my $allselected=$token->[2]{$name}; + $result=&mt($description); + foreach my $option (@$list) { + my ($value,$text); + if ( ref($option) eq 'ARRAY') { + $value='value="'.$$option[0].'"'; + $text=$$option[1]; + $option=$$option[0]; + } else { + $text=$option; + $value='value="'.$option.'"'; + } + $result.=''."\n"; + } + return $result; +} + +sub text_arg { + my ($description,$name,$token,$size) = @_; + my $result; + if (!defined $size) { $size=20; } + my $arg=$token->[2]{$name}; + $result=&mt($description).' '; + return ''.$result.''; +} + +sub select_arg { + my ($description,$name,$list,$token) = @_; + my $result; + my $optionlist=""; + my $selected=$token->[2]{$name}; + if (ref($list) eq 'ARRAY') { + foreach my $option (@{$list}) { + my ($text,$value); + if (ref($option) eq 'ARRAY') { + $value='value="'.&HTML::Entities::encode($option->[0]).'"'; + $text=$option->[1]; + $option=$option->[0]; + } else { + $text=$option; + $value='value="'.&HTML::Entities::encode($option,'\'"&<>').'"'; + } + if ( $selected eq $option ) { + $optionlist.="\n"; + } else { + $optionlist.="\n"; + } + } + } + $result.=''.&mt($description).' '; + return $result; +} + +sub select_or_text_arg { + my ($description,$name,$list,$token,$size) = @_; + my $result; + my $optionlist=""; + my $found=0; + my $selected=$token->[2]{$name}; + if (ref($list) eq 'ARRAY') { + foreach my $option (@{$list}) { + my ($text,$value); + if (ref($option) eq 'ARRAY') { + $value='value="'.&HTML::Entities::encode($option->[0]).'"'; + $text=$option->[1]; + $option=$option->[0]; + } else { + $text=$option; + $value='value="'.&HTML::Entities::encode($option,'\'"&<>').'"'; + } + if ( $selected eq $option ) { + $optionlist.="\n"; + $found=1; + } else { + $optionlist.="\n"; + } + } + } + $optionlist.="\n"; +# + my $change_code=&element_change_detection(); + my $element=&html_element_name($name); + my $selectelement='select_list_'.$element; + my $typeinelement='type_in_'.$element; + my $typeinvalue=($found?'':$selected); +# + my $hiddenvalue='this.form.'.$element.'.value'; + my $selectedindex='this.form.'.$selectelement.'.selectedIndex'; + my $selectedvalue='this.form.'.$selectelement. + '.options['.$selectedindex.'].value'; + my $typedinvalue='this.form.'.$typeinelement.'.value'; + my $selecttypeinindex='this.form.'.$selectelement.'.options.length'; + $description=&mt($description); +# + return (< +$description +  + + + +ENDSELECTORTYPE +} + +#----------------------------------------------------- image coordinates +# single image coordinates, x, y +sub entercoords { + my ($idx,$idy,$mode,$width,$height) = @_; + unless ($Apache::edit::bgimgsrc) { return ''; } + if ($idx) { $idx.='_'; } + if ($idy) { $idy.='_'; } + my $bgfile=&escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc)); + my $form = 'lonhomework'; + my $element; + if (! defined($mode) || $mode eq 'attribute') { + $element = &escape("$Apache::lonxml::curdepth"); + } elsif ($mode eq 'textnode') { # for data between ... + $element = &escape('homework_edit_'. + $Apache::lonxml::curdepth); + } + my $id=$Apache::lonxml::curdepth; + my %data=("imagechoice.$id.type" =>'point', + "imagechoice.$id.formname" =>$form, + "imagechoice.$id.formx" =>"$idx$element", + "imagechoice.$id.formy" =>"$idy$element", + "imagechoice.$id.file" =>$bgfile, + "imagechoice.$id.formcoord" =>$element); + if ($height) { + $data{"imagechoice.$id.formheight"}=$height.'_'. + $Apache::edit::bgimgsrccurdepth; + } + if ($width) { + $data{"imagechoice.$id.formwidth"}=$width.'_'. + $Apache::edit::bgimgsrccurdepth; + } + &Apache::lonnet::appenv(\%data); + my $text="Click Coordinates"; + my $result=''.$text.''; + return $result; +} + +# coordinates (x1,y1)-(x2,y2)... +# mode can be either box, or polygon +sub entercoord { + my ($idx,$mode,$width,$height,$type) = @_; + unless ($Apache::edit::bgimgsrc) { return ''; } + my $bgfile=&escape(&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$Apache::edit::bgimgsrc)); + my $form = 'lonhomework'; + my $element; + if (! defined($mode) || $mode eq 'attribute') { + $element = &escape("$idx\_$Apache::lonxml::curdepth"); + } elsif ($mode eq 'textnode') { # for data between ... + $element = &escape('homework_edit_'. + $Apache::lonxml::curdepth); + } + my $id=$Apache::lonxml::curdepth; + my %data=("imagechoice.$id.type" =>$type, + "imagechoice.$id.formname" =>$form, + "imagechoice.$id.file" =>$bgfile, + "imagechoice.$id.formcoord" =>$element); + if ($height) { + $data{"imagechoice.$id.formheight"}=$height.'_'. + $Apache::edit::bgimgsrccurdepth; + } + if ($width) { + $data{"imagechoice.$id.formwidth"}=$width.'_'. + $Apache::edit::bgimgsrccurdepth; + } + &Apache::lonnet::appenv(\%data); + my $text="Enter Coordinates"; + if ($type eq 'polygon') { $text='Create Polygon Data'; } + my $result=''.$text.''; + return $result; +} + +sub deletecoorddata { + &Apache::lonnet::delenv('imagechoice.'); +} + +#----------------------------------------------------- browse +sub browse { + # insert a link to call up the filesystem browser (lonindexer) + my ($id, $mode, $titleid, $only) = @_; + my $form = 'lonhomework'; + my $element; + if (! defined($mode) || $mode eq 'attribute') { + $element = &escape("$id\_$Apache::lonxml::curdepth"); + } elsif ($mode eq 'textnode') { # for data between ... + $element = &escape('homework_edit_'. + $Apache::lonxml::curdepth); + } + my $titleelement; + if ($titleid) { + $titleelement=",'$only','','".&escape("$titleid\_$Apache::lonxml::curdepth")."'"; } else { - $result=$result.$token->[2]; + $titleelement=",'$only'"; } - } - return $result; + my $result = <<"ENDBUTTON"; +Select +ENDBUTTON + return $result; } -sub insert_startouttext { - return "\n\n"; +#----------------------------------------------------- browse +sub search { + # insert a link to call up the filesystem browser (lonindexer) + my ($id, $mode, $titleid) = @_; + my $form = 'lonhomework'; + my $element; + if (! defined($mode) || $mode eq 'attribute') { + $element = &escape("$id\_$Apache::lonxml::curdepth"); + } elsif ($mode eq 'textnode') { # for data between ... + $element = &escape('homework_edit_'. + $Apache::lonxml::curdepth); + } + my $titleelement; + if ($titleid) { + $titleelement=",'".&escape("$titleid\_$Apache::lonxml::curdepth")."'"; + } + my $result = <<"ENDBUTTON"; +Search +ENDBUTTON + return $result; } + 1; __END__ + + 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.