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