ALDT (Arnulf's LaTeX Documentation Tool)

#=====================================================
# StringObjType.tcl 
# *
# * ALDT (Arnulf's Latex Documentation Tool)
# * A Tcl parser for LaTeX files for generating document output (for example html)
# *
# * Store info of a string LatexObj
# *
# * Released under same BSD license as Tcl.
# * (Tcl BSD license found at <http://www.tcl.tk/software/tcltk/license.html>)
# *
# * Copyright 2012 Arnulf P. Wiedemann
#=====================================================

namespace eval ::Parser {

::itcl::class StringObjType {
  public common oid 0

  private variable id

  private variable default_trim_chars " \t"

  constructor {} {}
  public method mySelf {}
  public method toString {}
  public method toDebugString {}
  public method setFromAny {obj_ptr}
  public method dupInternalRep {src_ptr dup_ptr}
  public method getString {obj_ptr}
  public method getStringLength {obj_ptr}
  public method newStringObjNoAlloc {str len where}
  public method newStringObj {str len where}
  public method newEmptyStringObj {where}
  public method _appendString {obj_ptr str len}
  public method appendString {obj_ptr str len}
  public method stringToWide {str wide_ptr}
  public method stringToDouble {str double_ptr}
  public method appendObj {obj_ptr append_obj_ptr}
}

  # ==================== constructor ==================================
::itcl::body StringObjType::constructor {} {
    incr oid
    set id $oid
  }

  # ==================== mySelf ==================================
::itcl::body StringObjType::mySelf {} {
    String str = "StringObjType!"+id+"!";
    return str;
  }

  # ==================== toString =====================================
::itcl::body StringObjType::toString {} {
    return "[mySelf]!"
  }

  # ==================== toDebugString =====================================
::itcl::body StringObjType::toDebugString {} {
    set str "[mySelf]\n"
    return $str
  }

  # ==================== setFromAny ==================================
::itcl::body StringObjType::setFromAny {obj_ptr} {
    # Get a fresh string representation. 
    obj_ptr.getString();
    /* Free any other internal representation. */
    obj_ptr.freeIntRep();
    /* Set it as string, i.e. just set the maxLength field. */
    obj_ptr.obj_type = OBJ_TYPE_STRING;
    obj_ptr.strValue_SetMaxLength(obj_ptr.len);
    /* Don't know the utf-8 length yet */
    obj_ptr.strValue_SetCharLength(-1);
    return OK;
  }

  # ==================== dupInternalRep ===================================== 
::itcl::body StringObjType::dupInternalRep {src_ptr dup_ptr} {
#    throw "string dupInternalRep not yet implemented";
    return ERROR;
  }

  # ==================== getString ==================================
  # Return the string representation for obj_ptr. If the object
  # string representation is invalid, calls the method to create
  # a new one starting from the internal representation of the object.

::itcl::body StringObjType::getString {obj_ptr} {
    return [$obj_ptr getString]
  }

  # ==================== getStringLength ==================================
::itcl::body StringObjType::getStringLength {obj_ptr} {
    return [$obj_ptr getLen]
  }

  # ==================== newStringObjNoAlloc ================================== 
::itcl::body StringObjType::newStringObjNoAlloc {str len where} {
    set obj_ptr [::Parser::LatexObj #auto]
    if {$len == -1} {
      set len [string length $str]
    }
    $obj_ptr setStringRep $obj_ptr $str $len
    $obj_ptr setObjType OBJ_TYPE_STRING
    $obj_ptr setAllocated $where
    $obj_ptr setFreed ""
    return $obj_ptr;
  }

  # ==================== newStringObj ================================== 
  # len is in bytes -- see also newStringObjUtf8() 
::itcl::body StringObjType::newStringObj {str len where} {
    set obj_ptr [::Parser::LatexObj #auto]

    # Need to find out how many bytes the string requires 
    if {$len == -1} {
      set len [string length $str]
    }
    $obj_ptr strValue_SetCharLength $len
    $obj_ptr strValue_SetMaxLength $len
    if {len == 0} {
      $obj_ptr setLen 0
      $obj_ptr setBbytes ""
    } else {
      $obj_ptr setBytes ""
      $obj_ptr setBytes "[$obj_ptr getBytes][string range $str 0 $len]"
      $obj_ptr setLen $len
    }

    # No obj_type field for the vanilla string object. 
    $obj_ptr setObjType OBJ_TYPE_STRING
    $obj_ptr setAllocated $where
    $obj_ptr setFreed ""
    return $obj_ptr;
  }

  # ==================== newEmptyStringObj ==================================
::itcl::body StringObjType::newEmptyStringObj {where} {
    set obj_ptr [newStringObj "" 0 "STRING_OBJ_x"]
    $obj_ptr setAllocated $where
    $obj_ptr setFreed ""
    return $obj_ptr;
  }

  # ==================== _appendString ==================================
  # Low-level string append. Use it only against objects
  # of type "string". 

::itcl::body StringObjType::_appendString {obj_ptr str len} {
    set need_len -1

    if {$len == -1} {
      set len [string length $str]
    }
    set need_len [expr {[$obj_ptr getLen] + $len}]
    # next line: force string respresentation 
    $obj_ptr getString
    if {[$obj_ptr strValue_GetMaxLength] < $need_len || [$obj_ptr strValue_GetMaxLength] == 0} {
      set need_len [expr {$need_len * 2}]
      # Inefficient to malloc() for less than 8 bytes 
      if {$need_len < 7} {
        set need_len 7
      }
      $obj_ptr strValue_SetMaxLength $need_len
    }
# FIXME this is just a hack!!
#if (obj_ptr.len < obj_ptr.bytes.length()) {
#obj_ptr.bytes.delete(obj_ptr.len, obj_ptr.bytes.length());
#}
    $obj_ptr setBytes "[$obj_ptr getBytes]$str"
    if {[$obj_ptr strValue_GetCharLength] >= 0} {
        # Update the utf-8 char length 
        $obj_ptr strValue_SetCharLength [expr {[$obj_ptr strValue_GetCharLength] + [string length [$obj_ptr getBytes]]}]
    }
    $obj_ptr setLen [expr {[$obj_ptr getLen] + $len}]
    return true
  }

  # ==================== appendString ==================================
  # Higher level API to append strings to objects.
::itcl::body StringObjType::appendString {obj_ptr str len} {
    panic [$obj_ptr isShared] "appendString called with shared object"
    if {[$obj_ptr getObjType] != OBJ_TYPE_STRING} {
      setFromAny $obj_ptr
    }
    _appendString $obj_ptr $str $len
    return true
  }

  # ==================== stringToWide ================================== 
::itcl::body StringObjType::stringToWide {str wide_ptr} {
    set val ""

    try {
      val = Long.parseLong(str);
    } catch(NumberFormatException e) {
      return ERROR;
    }
    wide_ptr.add(val);
    return true
  }

  # ==================== stringToDouble ==================================
::itcl::body StringObjType::stringToDouble {str double_ptr} {
    set val ""

    try {
      val = Double.parseDouble(str);
    } catch(NumberFormatException e) {
      return ERROR;
    } 
    double_ptr.add(val);
    return true
  }

  # ==================== appendObj ================================== 
::itcl::body StringObjType::appendObj {obj_ptr append_obj_ptr} {
    set str [$append_obj_ptr getString]
    set len [$append_obj_ptr getStringLength]
    appendString $obj_ptr $str $len
    return true
  }

}