Cases (#2495)

* Improve API to allocateRegister for debugging info

* Make sure ~ is a macro, otherwise \MakeUppercase (from latex.ltx) hangs

* Changes to (somewhat recent) LaTeX's \MakeUppercase,\MakeLowercase

* More careful warnings about setting attributes to non-strings only if attribute is allowed; likewise careful in setNodeBox,setNodeFont

* Back off (useless?) locator for FontDef (costly)

* Make command alias consistently be a Token

* Make a few commands robust (\ref,\cite,\ensuremath)

* Clarify what robust does; make more commands robust

* New implementation of \MakeUppercase,\MakeLowercase, also \MakeTitlecase, more closely mimicing modern latex

* textcase.sty is now essentially a NOOP, since it's functionality is included in base LaTeX

* Fix the silly return

* Reduce debugging noise

* Wording, comments, code tweaks suggested by d.ginev

lib/LaTeXML/Core/Definition.pm

@@ -37,15 +37,15 @@ sub getCS {
   my ($self) = @_;
   return $$self{cs}; }
 
+# Note: This returns the alias's CSName, if any.
 sub getCSName {
   my ($self) = @_;
-  return (defined $$self{alias} ? $$self{alias} : $$self{cs}->getCSName); }
+  return ($$self{alias} || $$self{cs})->getCSName; }
 
-# NOTE: Need to clean up alias; really should already be Token (or Tokens?)
-# and is not always a CS!
+# NOTE:  alias should be Token (or Tokens?)
 sub getCSorAlias {
   my ($self) = @_;
-  return (defined $$self{alias} ? T_CS($$self{alias}) : $$self{cs}); }
+  return $$self{alias} || $$self{cs}; }
 
 sub isExpandable {
   return 0; }
@@ -109,7 +109,7 @@ sub stringify {
   my ($self) = @_;
   my $type = ref $self;
   $type =~ s/^LaTeXML:://;
-  my $name = ($$self{alias} || $$self{cs}->getCSName);
+  my $name = $self->getCSName;
   return $type . '[' . ($$self{parameters}
     ? $name . ' ' . Stringify($$self{parameters}) : $name) . ']'; }
 

lib/LaTeXML/Core/Definition/Constructor.pm

@@ -60,10 +60,6 @@ sub getSizer {
   my ($self) = @_;
   return $$self{sizer}; }
 
-sub getAlias {
-  my ($self) = @_;
-  return $$self{alias}; }
-
 sub getNumArgs {
   my ($self) = @_;
   return $$self{nargs} if defined $$self{nargs};

lib/LaTeXML/Core/Definition/FontDef.pm

@@ -27,8 +27,7 @@ use base qw(LaTeXML::Core::Definition::Primitive);
 sub new {
   my ($class, $cs, $fontid, %traits) = @_;
   return bless { cs => $cs, parameters => undef,
-    fontID  => $fontid,
-    locator => $STATE->getStomach->getGullet->getMouth->getLocator,
+    fontID => $fontid,
     %traits }, $class; }
 
 # Return the "font info" associated with the (TeX) font that this command selects (See \font)

lib/LaTeXML/Core/Definition/Primitive.pm

@@ -64,10 +64,8 @@ sub invoke {
   my $replacement = $$self{replacement};
 
   if (!ref $replacement) {
-    my $alias = $$self{alias};
-    $alias = T_CS($alias) if $alias && !ref $alias;
     push(@result, Box($replacement, undef, undef,
-        Tokens($alias || $$self{cs}, ($parms ? $parms->revertArguments(@args) : ())),
+        Tokens($self->getCSorAlias, ($parms ? $parms->revertArguments(@args) : ())),
         (defined $replacement ? () : (isEmpty => 1)))); }
   else {
     push(@result, &{ $$self{replacement} }($stomach, @args)); }

lib/LaTeXML/Core/Document.pm

@@ -20,6 +20,7 @@ use LaTeXML::Common::Error;
 use LaTeXML::Common::XML;
 use LaTeXML::Util::Radix;
 use Unicode::Normalize;
+use Data::Dumper;
 use Scalar::Util qw(blessed);
 use base         qw(LaTeXML::Common::Object);
 
@@ -1376,41 +1377,46 @@ sub makeError {
 # [xml:id and namespaced attributes are always allowed]
 sub setAttribute {
   my ($self, $node, $key, $value) = @_;
-  if (ref $value) {
-    if ($key eq '_box') {
-      return $self->setNodeBox($node, $value); }
-    elsif ($key eq '_font') {
-      return $self->setNodeFont($node, $value); }
-    elsif ((!blessed($value)) || !$value->can('toAttribute')) {
-      Warn('unexpected', (ref $value), $self,
-        "Don't know how to encode $value as an attribute value");
+  my $model = $$self{model};
+  ## First, a couple of special case internal attributes
+  if ($key eq '_box') {
+    return $self->setNodeBox($node, $value); }
+  elsif ($key eq '_font') {
+    return $self->setNodeFont($node, $value); }
+  ## Next, verify the attribute allowed by Model, else internal or namespaced
+  elsif (($key =~ /:/) || ($key =~ /^_/)
+    || $model->canHaveAttribute($model->getNodeQName($node), $key)) {
+    ## OK, we're going to use the value, so make sure it's a string.
+    if (ref $value) {
+      if ((!blessed($value)) || !$value->can('toAttribute')) {
+        Warn('unexpected', (ref $value), $self,
+          "While setting attribute $key, Don't know how to encode $value",
+          Dumper($value));
+        return; }
+      else {
+        $value = $value->toAttribute; } }
+    if ((!defined $value) || ($value eq '')) {    # Useless value, after all
       return; }
-    else {
-      $value = $value->toAttribute; } }
-  if ((defined $value) && ($value ne '')) {    # Skip if `empty'; but 0 is OK!
-    if ($key eq 'xml:id') {                    # If it's an ID attribute
-      $value = recordID($self, $value, $node);                                 # Do id book keeping
-      $node->setAttributeNS($LaTeXML::Common::XML::XML_NS, 'id', $value); }    # and bypass all ns stuff
-    elsif ($key !~ /:/) {    # No colon; no namespace (the common case!)
-                             # Ignore attributes not allowed by the model,
-                             # but accept "internal" attributes.
-      my $model = $$self{model};
-      my $qname = $model->getNodeQName($node);
-      if ($model->canHaveAttribute($qname, $key) || $key =~ /^_/) {
-        $node->setAttribute($key => $value); } }
-    else {                   # Accept any namespaced attributes
-      my ($ns, $name) = $$self{model}->decodeQName($key);
-      if ($ns) {             # If namespaced attribute (must have prefix!
-        my $prefix = $node->lookupNamespacePrefix($ns);    # namespace already declared?
-        if (!$prefix) {                                    # if namespace not already declared
-          $prefix = $$self{model}->getDocumentNamespacePrefix($ns, 1);             # get the prefix to use
-          getDocument($self)->documentElement->setNamespace($ns, $prefix, 0); }    # and declare it
-        if ($prefix eq '#default') {    # Probably shouldn't happen...?
+    if ($key eq 'xml:id') {                       # If it's an ID attribute
+      $value = recordID($self, $value, $node);    # Do id book keeping
+      ## and bypass all ns stuff
+      $node->setAttributeNS($LaTeXML::Common::XML::XML_NS, 'id', $value); }
+    elsif ($key =~ /:/) {                         # ANY namespaced attribute
+      my ($ns, $name) = $model->decodeQName($key);
+      if ($ns) {                                  # If namespaced attribute (must have prefix!
+        my $prefix = $node->lookupNamespacePrefix($ns);    # already declared?
+        if (!$prefix) {                                    # Nope, not yet!
+          ## Create prefix to use, and declare it
+          $prefix = $model->getDocumentNamespacePrefix($ns, 1);
+          getDocument($self)->documentElement->setNamespace($ns, $prefix, 0); }
+        if ($prefix eq '#default') {                       # Probably shouldn't happen...?
           $node->setAttribute($name => $value); }
         else {
           $node->setAttributeNS($ns, "$prefix:$name" => $value); } }
       else {
-        $node->setAttribute($name => $value); } } }    # redundant case...
+        $node->setAttribute($name => $value); } }
+    else {    # Allowed (but NON-namespaced) or internal attribute
+      $node->setAttribute($key => $value); } }
   return; }
 
 sub addSSValues {
@@ -1661,11 +1667,17 @@ sub collapseXMDual {
 
 #**********************************************************************
 # Record the Box that created this node.
+# $box should be a Box/List/Whatsit object; else a previously recorded string
 sub setNodeBox {
   my ($self, $node, $box) = @_;
   return unless $box;
-  my $boxid = "$box";
-  $$self{node_boxes}{$boxid} = $box;
+  my $boxid = "$box";    # Effectively the address
+  if (ref $box) {
+    $$self{node_boxes}{$boxid} = $box; }
+  elsif (!$$self{node_boxes}{$box}) {
+    # Could get string for $box when copying nodes; should already be internned
+    Warn('internal', 'nonbox', $self,
+      "setNodeBox recording unknown source box: $box"); }
   return $node->setAttribute(_box => $boxid); }
 
 sub getNodeBox {
@@ -1676,14 +1688,20 @@ sub getNodeBox {
   if (my $boxid = $node->getAttribute('_box')) {
     return $$self{node_boxes}{$boxid}; } }
 
+# Record the font used on this node.
+# $font should be a Font object; else a previously recorded string
 sub setNodeFont {
   my ($self, $node, $font) = @_;
-  return unless ref $font;    # ?
-  my $fontid = $font->toString;
-  $$self{node_fonts}{$fontid} = $font;
+  my $fontid = (ref $font ? $font->toString : $font);
+  return unless $font;    # ?
   if ($node->nodeType == XML_ELEMENT_NODE) {
+    if (ref $font) {
+      $$self{node_fonts}{$fontid} = $font; }
+    elsif (!$$self{node_fonts}{$font}) {
+      # Could get string for $font when copying nodes; should already be internned
+      Warn('internal', 'nonfont', $self,
+        "setNodeFont recording unknown font: $font"); }
     $node->setAttribute(_font => $fontid); }
-  # otherwise, probably just ignorable?
   return; }
 
 # Possibly a sign of a design flaw; Set the node's font & all children that HAD the same font.
@@ -1704,7 +1722,9 @@ sub getNodeFont {
   my $t;
   while ($node && (($t = $node->nodeType) != XML_ELEMENT_NODE)) {
     $node = $node->parentNode; }
-  return ($node && ($t == XML_ELEMENT_NODE) && $$self{node_fonts}{ $node->getAttribute('_font') })
+  my $f;
+  return ($node && ($t == XML_ELEMENT_NODE)
+      && ($f = $node->getAttribute('_font')) && $$self{node_fonts}{$f})
     || LaTeXML::Common::Font->textDefault(); }
 
 sub getNodeLanguage {

lib/LaTeXML/Core/Whatsit.pm

@@ -124,11 +124,7 @@ sub revert {
         @tokens = $self->substituteParameters($spec)
           if $spec ne ''; }
       else {
-        my $alias = $defn->getAlias;
-        if (defined $alias) {
-          push(@tokens, (ref $alias ? $alias : T_CS($alias))) if $alias ne ''; }
-        else {
-          push(@tokens, $defn->getCS); }
+        push(@tokens, $defn->getCSorAlias);
         if (my $parameters = $defn->getParameters) {
           push(@tokens, $parameters->revertArguments($self->getArgs)); } }
       if (defined(my $body = $self->getBody)) {