[WWcvs] pg: Added redefine() function to complement undefine() for various

[dpvc v. a. <we...@ma...>]

Log Message:
-----------
Added redefine() function to complement undefine() for various
Context() values.  For example

      Context()->operators->undefine('+');

makes '+' undefined, but

      Context()->operators->redefine('+');

will put it back.  You can specify a context from which to take the
redefinition, and a name in that context, as in

      Context()->operators->redefine('U',from=>"Interval");
      Context()->operators->redefine('u',from=>"Interval",using=>"U");
      Context()->operators->redefine('U',from=>$content);

where $content is a reference to a Context object.

The undefine() function lets you undefine several items at once, as in

      Context()->operators->undefine('+','-');

For redefine, you must put multiple names in square brackets because
of the optional parmeters:

      Context()->operators->redefine(['+','-']);

Modified Files:
--------------
    pg/lib/Parser/Context:
        Functions.pm
        Operators.pm
    pg/lib/Value/Context:
        Data.pm

Revision Data
-------------
Index: Functions.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Functions.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/Context/Functions.pm -Llib/Parser/Context/Functions.pm -u -r1.6 -r1.7
--- lib/Parser/Context/Functions.pm
+++ lib/Parser/Context/Functions.pm
@@ -19,12 +19,31 @@
 #  Remove a function from the list by assigning it
 #    the undefined function.  This means it will still
 #    be recognized by the parser, but will generate an
-#    error message whenever it is used.
+#    error message whenever it is used.  The old class
+#    is saved so that it can be redefined again.
 #
 sub undefine {
   my $self = shift;
   my @data = ();
-  foreach my $x (@_) {push(@data,$x => {class => 'Parser::Function::undefined'})}
+  foreach my $x (@_) {
+    push(@data,$x => {
+      oldClass => $self->get($x)->{class},
+      class => 'Parser::Function::undefined',
+    });
+  }
+  $self->set(@data);
+}
+
+sub redefine {
+  my $self = shift; my $X = shift;
+  return $self->SUPER::redefine($X,@_) if scalar(@_) > 0;
+  $X = [$X] unless ref($X) eq 'ARRAY';
+  my @data = ();
+  foreach my $x (@{$X}) {
+    my $oldClass = $self->get($x)->{oldClass};
+    push(@data,$x => {class => $oldClass, oldClass => undef})
+      if $oldClass;
+  }
   $self->set(@data);
 }
 
@@ -71,6 +90,7 @@
 sub enable {Enable(@_)}
 sub Enable {
   my $context = Parser::Context->current;
+  my $functions = $Parser::Context::Default::fullContext->{functions};
   if (ref($_[0]) ne "") {$context = (shift)->{context}}
   my @names = @_; my ($list,$name);
   while ($name = shift(@names)) {
@@ -79,10 +99,8 @@
     unless (defined($list)) {warn "Undefined function or category '$name'"; next}
     if ($list->[0] eq '_alias_') 
       {unshift @names, @{$list}[1..scalar(@{$list})-1]; next}
-    my @fn; foreach my $f (@{$list}) {
-      push @fn, $f => 
-        {class => $Parser::Context::Default::fullContext->{functions}{$f}{class}};
-    }
+    my @fn; foreach my $f (@{$list}) 
+      {push @fn, $f => {class => $functions->{$f}{class}}}
     $context->functions->set(@fn);
   }
 }
Index: Operators.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Operators.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/Context/Operators.pm -Llib/Parser/Context/Operators.pm -u -r1.3 -r1.4
--- lib/Parser/Context/Operators.pm
+++ lib/Parser/Context/Operators.pm
@@ -26,14 +26,33 @@
   my @data = ();
   foreach my $x (@_) {
     if ($self->{context}{operators}{$x}{type} eq 'unary') {
-      push(@data,$x => {class => 'Parser::UOP::undefined'});
+      push(@data,$x => {
+	class => 'Parser::UOP::undefined',
+	oldClass => $self->get($x)->{class},
+      });
     } else {
-      push(@data,$x => {class => 'Parser::BOP::undefined'});
+      push(@data,$x => {
+	class => 'Parser::BOP::undefined',
+	oldClass => $self->get($x)->{class},
+      });
     }
   }
   $self->set(@data);
 }
 
+sub redefine {
+  my $self = shift; my $X = shift;
+  return $self->SUPER::redefine($X,@_) if scalar(@_) > 0;
+  $X = [$X] unless ref($X) eq 'ARRAY';
+  my @data = ();
+  foreach my $x (@{$X}) {
+    my $oldClass = $self->get($x)->{oldClass};
+    push(@data,$x => {class => $oldClass, oldClass => undef})
+      if $oldClass;
+  }
+  $self->set(@data);
+}
+
 #########################################################################
 
 1;
Index: Data.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context/Data.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Value/Context/Data.pm -Llib/Value/Context/Data.pm -u -r1.6 -r1.7
--- lib/Value/Context/Data.pm
+++ lib/Value/Context/Data.pm
@@ -142,6 +142,28 @@
 #
 sub undefine {my $self = shift; $self->remove(@_)}
 
+#
+#  Redefine items from the default context, or a given one
+#
+sub redefine {
+  my $self = shift; my $X = shift;
+  my %options = (using => undef, from => "Full", @_);
+  my $Y = $options{using}; my $from = $options{from};
+  $from = $Parser::Context::Default::context{$from} unless ref($from);
+  $Y = $X if !defined($Y) && !ref($X);
+  $X = [$X] unless ref($X) eq 'ARRAY';
+  my @data = (); my @remove = ();
+  foreach my $x (@{$X}) {
+    my $y = defined($Y)? $Y: $x;
+    Value::Error("No definition for %s '%s' in the given context",$self->{name},$y)
+      unless $from->{$self->{dataName}}{$y};
+    push(@remove,$x) if $self->get($x);
+    push(@data,$x => $from->{$self->{dataName}}{$y});
+  }
+  $self->remove(@remove);
+  $self->add(@data);
+}
+
 
 #
 #  Get hash for an item