
namespace eval ::textutil {

    namespace eval adjust {

        variable here [file dirname [info script]]
        variable StrRepeat [ namespace parent ]::strRepeat
        variable Justify  left
        variable Length   72
        variable FullLine 0
        variable StrictLength 0
        variable Hyphenate    0
        variable HyphPatterns

        namespace export adjust indent undent

        # This will be redefined later. We need it just to let
        # a chance for the next import subcommand to work
        #
        proc adjust { text args } { }
        proc indent { text args } { }
        proc undent { text args } { }
    }

    namespace import -force adjust::adjust adjust::indent adjust::undent
    namespace export adjust indent undent

}

#########################################################################

proc ::textutil::adjust::adjust { text args } {

    if { [ string length [ string trim $text ] ] == 0 } then {
        return ""
    }

    Configure $args
    Adjust text newtext

    return $newtext
}

proc ::textutil::adjust::Configure { args } {
  variable Justify         left
  variable Length    72
  variable FullLine  0
  variable StrictLength 0
  variable Hyphenate    0
  variable HyphPatterns;                       # hyphenation patterns (TeX)

    set args [ lindex $args 0 ]
    foreach { option value } $args {
      switch -exact -- $option {
        -full {
          if { ![ string is boolean -strict $value ] } then {
            error "expected boolean but got \"$value\""
          }
          set FullLine [ string is true $value ]
        }
        -hyphenate {
          # the word exceeding the length of line is tried to be
          # hyphenated; if a word cannot be hyphenated to fit into
          # the line processing stops! The length of the line should
          # be set to a reasonable value!

          if { ![ string is boolean -strict $value ] } then {
            error "expected boolean but got \"$value\""
          }
          set Hyphenate [string is true $value]
          if { $Hyphenate && ![info exists HyphPatterns(_LOADED_)]} {
            error "hyphenation patterns not loaded!"
          }
        }
        -justify {
          set lovalue [ string tolower $value ]
          switch -exact -- $lovalue {
            left -
            right -
            center -
            plain {
              set Justify $lovalue
            }
            default {
              error "bad value \"$value\": should be center, left, plain or right"
            }
          }
        }
        -length {
          if { ![ string is integer $value ] } then {
            error "expected positive integer but got \"$value\""
          }
          if { $value < 1 } then {
            error "expected positive integer but got \"$value\""
          }
          set Length $value
        }
        -strictlength {
          # the word exceeding the length of line is moved to the
          # next line without hyphenation; words longer than given
          # line length are cut into smaller pieces

          if { ![ string is boolean -strict $value ] } then {
            error "expected boolean but got \"$value\""
          }
          set StrictLength [ string is true $value ]
        }
        default {
          error "bad option \"$option\": must be -full, -hyphenate, \
          -justify, -length, or -strictlength"
        }
      }
    }

    return ""
}

# ::textutil::adjust::Adjust
#
# History:
#      rewritten on 2004-04-13 for bugfix tcllib-bugs-882402 (jhv)

proc ::textutil::adjust::Adjust { varOrigName varNewName } {
  variable Length
  variable FullLine
  variable StrictLength
  variable Hyphenate

  upvar $varOrigName orig
  upvar $varNewName  text

  set pos 0;                                   # Cursor after writing
  set line ""
  set text ""


  if {!$FullLine} {
    regsub -all -- "(\n)|(\t)"     $orig   " "  orig
    regsub -all -- " +"            $orig  " "   orig
    regsub -all -- "(^ *)|( *\$)"  $orig  ""    orig
  }

  set words [split $orig];
  set numWords [llength $words];
  set numline 0;

  for {set cnt 0} {$cnt < $numWords} {incr cnt} {

    set w [lindex $words $cnt];
    set wLen [string length $w];

    # the word $w doesn't fit into the present line
    # case #1: we try to hyphenate

    if {$Hyphenate && ($pos+$wLen >= $Length)} {
      # Hyphenation instructions
      set w2 [textutil::adjust::Hyphenation $w];

      set iMax [llength $w2];
      if {$iMax == 1 && [string length $w] > $Length} {
        # word cannot be hyphenated and exceeds linesize

        error "Word \"$w2\" can\'t be hyphenated\
        and exceeds linesize $Length!"
      } else {
        # hyphenating of $w was successfull, but we have to look
        # that every sylable would fit into the line

        foreach x $w2 {
          if {[string length $x] >= $Length} {
            error "Word \"$w\" can\'t be hyphenated\
            to fit into linesize $Length!"
          }
        }
      }

      for {set i 0; set w3 ""} {$i < $iMax} {incr i} {
        set syl [lindex $w2 $i];
        if {($pos+[string length " $w3$syl-"]) > $Length} {break}
        append w3 $syl;
      }
      for {set w4 ""} {$i < $iMax} {incr i} {
        set syl [lindex $w2 $i];
        append w4 $syl;
      }

      if {[string length $w3] && [string length $w4]} {
        # hyphenation was successfull: redefine
        # list of words w => {"$w3-" "$w4"}

        set x [lreplace $words $cnt $cnt "$w4"];
        set words [linsert $x $cnt "$w3-"];
        set w [lindex $words $cnt];
        set wLen [string length $w];
        incr numWords;
      }
    }

    # the word $w doesn't fit into the present line
    # case #2: we try to cut the word into pieces

    if {$StrictLength && ([string length $w] > $Length)} {
      # cut word into two pieces
      set w2 $w;

      set over [expr $pos+2+$wLen-$Length];
      set w3 [string range $w2 0 $Length]
      set w4 [string range $w2 [expr $Length+1] end];

      set x [lreplace $words $cnt $cnt $w4];
      set words [linsert $x $cnt $w3 ];
      set w [lindex $words $cnt];
      set wLen [string length $w];
      incr numWords;
    } else {
      ;
    }

    # continuing with the normal procedure

    if {($pos+$wLen < $Length)} {
      # append word to current line

      if {$pos} {append line " "; incr pos}
      append line $w;
      incr pos $wLen;
    } else {
      # line full => write buffer and  begin a new line

      if [string length $text] {append text "\n"}
      append text [Justification $line [incr numline]];
      set line $w;
      set pos $wLen;
    }
  }

  # write buffer and return!

  if [string length $text] {append text "\n"}
  append text [Justification $line end];
  return $text
}

# ::textutil::adjust::Justification
#
# justify a given line
#
# Parameters:
#      line    text for justification
#      index   index for line in text
#
# Returns:
#      the justified line
#
# Remarks:
#      Only lines with size not exceeding the max. linesize provided
#      for text formatting are justified!!!

proc ::textutil::adjust::Justification { line index } {
  variable Justify
  variable Length
  variable FullLine
  variable StrRepeat

  set len [string length $line];               # length of current line

  if { $Length <= $len } then {
    # the length of current line ($len) is equal as or greater than
    # the value provided for text formatting ($Length) => to avoid
    # inifinite loops we leave $line unchanged and return!

    return $line;
  }

  # Special case:
  # for the last line, and if the justification is set to 'plain'
  # the real justification is 'left' if the length of the line
  # is less than 90% (rounded) of the max length allowed. This is
  # to avoid expansion of this line when it is too small: without
  # it, the added spaces will 'unbeautify' the result.
  #

  set justify $Justify;
  if { ( "$index" == "end" ) && \
       ( "$Justify" == "plain" ) && \
       ( $len < round($Length * 0.90) ) } then {
         set justify left;
  }

  # For a left justification, nothing to do, but to
  # add some spaces at the end of the line if requested

  if { "$justify" == "left" } then {
    set jus ""
    if { $FullLine } then {
      set jus [ $StrRepeat " " [ expr { $Length - $len } ] ]
    }
    return "${line}${jus}";
  }

  # For a right justification, just add enough spaces
  # at the beginning of the line

  if { "$justify" == "right" } then {
    set jus [ $StrRepeat " " [ expr { $Length - $len } ] ]
    return "${jus}${line}";
  }

  # For a center justification, add half of the needed spaces
  # at the beginning of the line, and the rest at the end
  # only if needed.

  if { "$justify" == "center" } then {
    set mr [ expr { ( $Length - $len ) / 2 } ]
    set ml [ expr { $Length - $len - $mr } ]
    set jusl [ $StrRepeat " " $ml ]
    set jusr [ $StrRepeat " " $mr ]
    if { $FullLine } then {
      return "${jusl}${line}${jusr}"
    } else {
      return "${jusl}${line}"
    }
  }

  # For a plain justification, it's a little bit complex:
  #
  # if some spaces are missing, then
  #
  # 1) sort the list of words in the current line by decreasing size
  # 2) foreach word, add one space before it, except if it's the
  #    first word, until enough spaces are added
  # 3) rebuild the line

  if { "$justify" == "plain" } then {
    set miss [ expr { $Length - [ string length $line ] } ]

    # Bugfix tcllib-bugs-860753 (jhv)

    set words [split $line];
    set numWords [llength $words];

    if {$numWords < 2} {
      # current line consists of less than two words - we can't
      # insert blanks to achieve a plain justification => leave
      # $line unchanged and return!

      return $line;
    }

    for {set i 0; set totalLen 0} {$i < $numWords} {incr i} {
      set w($i) [lindex $words $i];
      if {$i > 0} {set w($i) " $w($i)"};
      set wLen($i) [string length $w($i)];
      set totalLen [expr $totalLen+$wLen($i)];
    }

    set miss [expr {$Length - $totalLen}];

    # len walks through all lengths of words of the line under
    # consideration

    for {set len 1} {$miss > 0} {incr len} {
      for {set i 1} {($i < $numWords) && ($miss > 0)} {incr i} {
        if {$wLen($i) == $len} {
          set w($i) " $w($i)";
          incr wLen($i);
          incr miss -1;
        }
      }
    }

    set line "";
    for {set i 0} {$i < $numWords} {incr i} {
      set line "$line$w($i)";
    }

    # End of bugfix

    return "${line}"
  }

  error "Illegal justification key \"$justify\""
}

proc ::textutil::adjust::SortList { list dir index } {

    if { [ catch { lsort -integer -$dir -index $index $list } sl ] != 0 } then {
        error "$sl"
    }

    return $sl
}

# Hyphenation utilities based on Knuth's algorithm
#
# Copyright (C) 2001-2003 by Dr.Johannes-Heinrich Vogeler (jhv)
# These procedures may be used as part of the tcllib

# textutil::adjust::Hyphenation
#
#      Hyphenate a string using Knuth's algorithm
#
# Parameters:
#      str     string to be hyphenated
#
# Returns:
#      the hyphenated string

proc ::textutil::adjust::Hyphenation { str } {

  # if there are manual set hyphenation marks e.g. "Recht\-schrei\-bung"
  # use these for hyphenation and return

  if [regexp {[^\\-]*[\\-][.]*} $str] {
    regsub -all {(\\)(-)} $str {-} tmp;
    return [split $tmp -];
  }

  # Don't hyphenate very short words! Minimum length for hyphenation
  # is set to 3 characters!

  if { [string length $str] < 4 } then { return $str }

  # otherwise follow Knuth's algorithm

  variable HyphPatterns;                       # hyphenation patterns (TeX)

  set w ".[string tolower $str].";             # transform to lower case
  set wLen [string length $w];                 # and add delimiters

  # Initialize hyphenation weights

  set s {}
  for {set i 0} {$i < $wLen} {incr i} {
    lappend s 0;
  }

  for {set i 0} {$i < $wLen} {incr i} {
    set kmax [expr $wLen-$i];
    for {set k 1} {$k < $kmax} {incr k} {
      set sw [string range $w $i [expr $i+$k]];
      if [info exists HyphPatterns($sw)] {
        set hw $HyphPatterns($sw);
        set hwLen [string length $hw];
        for {set l1 0; set l2 0} {$l1 < $hwLen} {incr l1} {
          set c [string index $hw $l1];
          if [string is digit $c] {
            set sPos [expr $i+$l2];
            if {$c > [lindex $s $sPos]} {
              set s [lreplace $s $sPos $sPos $c];
            }
          } else {
            incr l2;
          }
        }
      }
    }
  }

  # Replace all even hyphenation weigths by zero

  for {set i 0} {$i < [llength $s]} {incr i} {
    set c [lindex $s $i];
    if ![expr $c%2] { set s [lreplace $s $i $i 0] }
  }

  # Don't start with a hyphen! Take also care of words enclosed in quotes
  # or that someone has forgotten to put a blank between a punctuation
  # character and the following word etc.

  for {set i 1} {$i < [expr $wLen-1]} {incr i} {
    set c [string range $w $i end]
    if [regexp {^[:alpha:][.]*} $c] {
      for {set k 1} {$k < [expr $i+1]} {incr k} {
        set s [lreplace $s $k $k 0];
      }
      break
    }
  }

  # Don't separate the last character of a word with a hyphen

  set max [expr [llength $s]-2];
  if {$max} {set s [lreplace $s $max end 0]}

  # return the syllabels of the hyphenated word as a list!

  set ret "";
  set w ".$str.";
  for {set i 1} {$i < [expr $wLen-1]} {incr i} {
    if [lindex $s $i] { append ret - }
    append ret [string index $w $i];
  }
  return [split $ret -];
}

# textutil::adjust::listPredefined
#
#      Return the names of the hyphenation files coming with the package.
#
# Parameters:
#      None.
#
# Result:
#       List of filenames (without directory)

proc ::textutil::adjust::listPredefined {} {
    variable here
    return [glob -type f -directory $here -tails *.tex]
}

# textutil::adjust::getPredefined
#
#      Retrieve the full path for a predefined hyphenation file
#       coming with the package.
#
# Parameters:
#      name     Name of the predefined file.
#
# Results:
#       Full path to the file, or an error if it doesn't
#       exist or is matching the pattern *.tex.

proc ::textutil::adjust::getPredefined {name} {
    variable here

    if {![string match *.tex $name]} {
        return -code error \
                "Illegal hyphenation file \"$name\""
    }
    set path [file join $here $name]
    if {![file exists $path]} {
        return -code error \
                "Unknown hyphenation file \"$path\""
    }
    return $path
}

# textutil::adjust::readPatterns
#
#      Read hyphenation patterns from a file and store them in an array
#
# Parameters:
#      filNam  name of the file containing the patterns

proc ::textutil::adjust::readPatterns { filNam } {

  variable HyphPatterns;                       # hyphenation patterns (TeX)

  # HyphPatterns(_LOADED_) is used as flag for having loaded
  # hyphenation patterns from the respective file (TeX format)

  if [info exists HyphPatterns(_LOADED_)] {
    unset HyphPatterns(_LOADED_);
  }

  # the array xlat provides translation from TeX encoded characters
  # to those of the ISO-8859-1 character set

  set xlat(\"s) \337;                          # 223 := sharp s
  set xlat(\`a) \340;                          # 224 := a, grave
  set xlat(\'a) \341;                          # 225 := a, acute
  set xlat(\^a) \342;                          # 226 := a, circumflex
  set xlat(\"a) \344;                          # 228 := a, diaeresis
  set xlat(\`e) \350;                          # 232 := e, grave
  set xlat(\'e) \351;                          # 233 := e, acute
  set xlat(\^e) \352;                          # 234 := e, circumflex
  set xlat(\`i) \354;                          # 236 := i, grave
  set xlat(\'i) \355;                          # 237 := i, acute
  set xlat(\^i) \356;                          # 238 := i, circumflex
  set xlat(\~n) \361;                          # 241 := n, tilde
  set xlat(\`o) \362;                          # 242 := o, grave
  set xlat(\'o) \363;                          # 243 := o, acute
  set xlat(\^o) \364;                          # 244 := o, circumflex
  set xlat(\"o) \366;                          # 246 := o, diaeresis
  set xlat(\`u) \371;                          # 249 := u, grave
  set xlat(\'u) \372;                          # 250 := u, acute
  set xlat(\^u) \373;                          # 251 := u, circumflex
  set xlat(\"u) \374;                          # 252 := u, diaeresis

  set fd [open $filNam RDONLY];
  set status 0;

  while {[gets $fd line] >= 0} {

    switch -exact $status {
      PATTERNS {
        if [regexp {^\}[.]*} $line] {
          # End of patterns encountered: set status
          # and ignore that line
          set status 0;
          continue;
        } else {
          # This seems to be pattern definition line; to process it
          # we have first to do some editing
          #
          # 1) eat comments in a pattern definition line
          # 2) eat braces and coded linefeeds

          set z [string first "%" $line];
          if {$z > 0} { set line [string range $line 0 [expr $z-1]] }

          regsub -all {(\\n|\{|\})} $line {} tmp;
          set line $tmp;

          # Now $line should consist only of hyphenation patterns
          # separated by white space

          # Translate TeX encoded characters to ISO-8859-1 characters
          # using the array xlat defined above

          foreach x [array names xlat] {
            regsub -all {$x} $line $xlat($x) tmp;
            set line $tmp;
          }

          # split the line and create a lookup array for
          # the repective hyphenation patterns

          foreach item [split $line] {
            if [string length $item] {
              if ![string match {\\} $item] {
                # create index for hyphenation patterns

                set var $item;
                regsub -all {[0-9]} $var {} idx;
                # store hyphenation patterns as elements of an array

                set HyphPatterns($idx) $item;
              }
            }
          }
        }
      }
      EXCEPTIONS {
        if [regexp {^\}[.]*} $line] {
          # End of patterns encountered: set status
          # and ignore that line
          set status 0;
          continue;
        } else {
          # to be done in the future
        }
      }
      default {
        if [regexp {^\\endinput[.]*} $line] {
          # end of data encountered, stop processing and
          # ignore all the following text ..
          break;
        } elseif [regexp {^\\patterns[.]*} $line] {
          # begin of patterns encountered: set status
          # and ignore that line
          set status PATTERNS;
          continue;
        } elseif [regexp {^\\hyphenation[.]*} $line] {
          # some particular cases to be treated separately
          set status EXCEPTIONS
          continue;
        } else {
          set status 0;
        }
      }
    }                  ;# switch
  }

  close $fd;
  set HyphPatterns(_LOADED_) 1;

  return;
}

#######################################################

# @c The specified <a text>block is indented
# @c by <a prefix>ing each line. The first
# @c <a hang> lines ares skipped.
#
# @a text:   The paragraph to indent.
# @a prefix: The string to use as prefix for each line
# @a prefix: of <a text> with.
# @a skip:   The number of lines at the beginning to leave untouched.
#
# @r Basically <a text>, but indented a certain amount.
#
# @i indent
# @n This procedure is not checked by the testsuite.

proc ::textutil::adjust::indent {text prefix {skip 0}} {
    set text [string trimright $text]

    set res [list]
    foreach line [split $text \n] {
        if {[string compare "" [string trim $line]] == 0} {
            lappend res {}
        } else {
	    set line [string trimright $line]
	    if {$skip <= 0} {
		lappend res $prefix$line
	    } else {
		lappend res $line
	    }
	}
        if {$skip > 0} {incr skip -1}
    }
    return [join $res \n]
}

# Undent the block of text: Compute LCP (restricted to whitespace!)
# and remove that from each line. Note that this preverses the
# shaping of the paragraph (i.e. hanging indent are _not_ flattened)
# We ignore empty lines !!

proc ::textutil::adjust::undent {text} {

    if {$text == {}} {return {}}

    set lines [split $text \n]
    set ne [list]
    foreach l $lines {
        if {[string length [string trim $l]] == 0} continue
        lappend ne $l
    }
    set lcp [::textutil::longestCommonPrefixList $ne]

    if {[string length $lcp] == 0} {return $text}

    regexp {^([         ]*)} $lcp -> lcp

    if {[string length $lcp] == 0} {return $text}

    set len [string length $lcp]

    set res [list]
    foreach l $lines {
        if {[string length [string trim $l]] == 0} {
            lappend res {}
        } else {
            lappend res [string range $l $len end]
        }
    }
    return [join $res \n]
}
