Annotation of loncom/homework/edit.pm, revision 1.26
1.1 albertel 1: # The LearningOnline Network with CAPA
2: # edit mode helpers
1.25 albertel 3: #
1.26 ! harris41 4: # $Id: edit.pm,v 1.25 2001/12/04 14:47:33 albertel Exp $
1.25 albertel 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;
1.26 ! harris41 292: foreach (split ("\n", $$data)) { $count++;
1.25 albertel 293: if (length($_) > $maxlength) { $maxlength = length($_); }
1.26 ! harris41 294: }
1.25 albertel 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__
1.26 ! harris41 425:
! 426: =head1 NAME
! 427:
! 428: Apache::edit - edit mode helpers
! 429:
! 430: =head1 SYNOPSIS
! 431:
! 432: Invoked by many homework and xml related modules.
! 433:
! 434: &Apache::edit::SUBROUTINENAME(ARGUMENTS);
! 435:
! 436: =head1 INTRODUCTION
! 437:
! 438: This module outputs HTML syntax helpful for the rendering of edit
! 439: mode interfaces.
! 440:
! 441: This is part of the LearningOnline Network with CAPA project
! 442: described at http://www.lon-capa.org.
! 443:
! 444: =head1 HANDLER SUBROUTINE
! 445:
! 446: There is no handler subroutine.
! 447:
! 448: =head1 OTHER SUBROUTINES
! 449:
! 450: =over 4
! 451:
! 452: =item *
! 453:
! 454: initialize_edit() : initialize edit (set colordepth to zero)
! 455:
! 456: =item *
! 457:
! 458: tag_start($target,$token,$description) : provide deletion and insertion lists
! 459: for the manipulation of a start tag; return a scalar string
! 460:
! 461: =item *
! 462:
! 463: tag_end($target,$token,$description) : ending syntax corresponding to
! 464: &tag_start. return a scalar string.
! 465:
! 466: =item *
! 467:
! 468: start_table($token) : start table; update colordepth; return scalar string.
! 469:
! 470: =item *
! 471:
! 472: end_table() : reduce color depth; end table; return scalar string
! 473:
! 474: =item *
! 475:
! 476: movebuttons($target,$token) : move-up and move-down buttons; return scalar
! 477: string
! 478:
! 479: =item *
! 480:
! 481: deletelist($target,$token) : provide a yes option in an HTML select element;
! 482: return scalar string
! 483:
! 484: =item *
! 485:
! 486: handle_delete($space,$target,$token,$tagstack,$parstack,$parser,$safeeval,
! 487: $style) : respond to a user delete request by passing relevant stack
! 488: and array information to various rendering functions; return a scalar string
! 489:
! 490: =item *
! 491:
! 492: get_insert_list($token) : provide an insertion list based on possibilities
! 493: from lonxml; return a scalar string
! 494:
! 495: =item *
! 496:
! 497: insertlist($target,$token) : api that uses get_insert_list;
! 498: return a scalar string
! 499:
! 500: =item *
! 501:
! 502: handleinsert($token) : provide an insertion list based on possibilities
! 503: from lonxml; return a scalar string
! 504:
! 505: =item *
! 506:
! 507: get_insert_list($token) : provide an insertion list based on possibilities
! 508: from lonxml; return a scalar string
! 509:
! 510: =back
! 511:
! 512: incomplete...
! 513:
! 514: =cut
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