string indent

wdb When playing around I need properly indented sources. Here a package which extends string command by new subcommand indent.

Internals: first make a nested list of braced (or quoted) level substrings; second, for every substring, each linefeed triggers appending its nesting depth to a list; third process list of levels and list of lines; finally cosmetics: closing brace un-indent by one level, indent backslashed line-continuations. Youʼve seen it, now forget it.

Example session. Set a string:

 % set src {proc rangesWithoutPattern {win pattern {from insert} {to end} args} {
 # return ranges without 1 pattern $pattern
 lassign [info level 0] recurse  
 lappend result [$win index $from]
 set count ""
 set indices [$win search -all -regexp -nolinestop -count count $pattern $from $to]
 foreach i $indices c $count {
 lappend result $i [$win index "$i + $c chars"]
 }
 lappend result $to
 if {$args ne ""} then {
 lappend result {*}[$recurse $win $pattern {*}$args]
 }
 set result
 }}

Now, indent:

 % string indent $src
 proc rangesWithoutPattern {win pattern {from insert} {to end} args} {
   # return ranges without 1 pattern $pattern
   lassign [info level 0] recurse  
   lappend result [$win index $from]
   set count ""
   set indices [$win search -all -regexp -nolinestop -count count $pattern $from $to]
   foreach i $indices c $count {
     lappend result $i [$win index "$i + $c chars"]
   }
   lappend result $to
   if {$args ne ""} then {
     lappend result {*}[$recurse $win $pattern {*}$args]
   }
   set result
 }

Caution should be taken. Quoted levels ("...") are nested as well as braced levels ({...}).

PS licence OLL as always. Have fun.

#
# file IndentString-0.1.tm
#
# extend new subcommand:
# string indent $str
# returns properly indented code
#

package require Tcl 8.6.1
package provide IndentString 0.1

namespace eval IndentString {
  namespace import ::tcl::mathfunc::* ::tcl::mathop::*
}

proc IndentString::firstSplitIndex {src {start 0}} {
  lassign [info level 0] recurse
  set quote [string first \u0022 $src $start]
  set brace [string first \u007b $src $start]
  if {$quote >= 0 || $brace >= 0} then {
    if {$quote < 0} then {
      set index $brace
    } elseif {$brace < 0} then {
      set index $quote
    } else {
      set index [min $quote $brace]
    }
    set part0 [string range $src 0 $index]
    if {[info complete $part0]} then {
      $recurse $src [+ $index 1]
    } else {
      set index
    }
  } else {
    return -1
  }
}

proc IndentString::completePartLength src {
  # length when [info complete (part of $src)]
  set i 0
  set l [string length $src]
  set part [string range $src 0 $i]
  while {$i < $l && ![info complete $part]} {
    # rustilal ;-)
    set part [string range $src 0 [incr i]]
  }
  if {[info complete $part]} then {
    set i
  } else {
    set i -1
  }
}

proc IndentString::splitByLevels src {
  lassign [info level 0] recurse
  set i [firstSplitIndex $src]
  if {$i < 0} then {
    list $src
  } else {
    set tail [string range $src $i end]
    set l [completePartLength $tail]
    set body [string range $tail 0 $l]
    set rest [string range $tail [+ $l 1] end]
    list [string range $src 0 [- $i 1]]\
      [$recurse [string range $body 1 end-1]]\
      {*}[$recurse $rest]
  }
}

proc IndentString::lfIndices str {
  lsearch -all [split $str ""] \n
}


proc IndentString::notifyLevel {li {_result result} {level 0}} {
  # for every lf write depth to external result
  lassign [info level 0] recurse
  upvar $_result result
  foreach i [lfIndices [lindex $li 0]] {
    lappend result $level
  }
  foreach {a b} [lrange $li 1 end] {
    $recurse $a result [+ $level 1]
    foreach i [lfIndices $b] {
      lappend result $level
    }
  }
}

proc IndentString::listOfLevels src {
  set result {}
  set li [splitByLevels $src]
  notifyLevel $li result
  set result
}

proc IndentString::indentStr str {
  if {[info complete $str]} then {
    set li [splitByLevels [string map [list \\\n "_\n"] $str]]
    set levels [listOfLevels $li]
    set lines [lmap x [split $str \n] {string trimleft $x " "}]
    set result [lindex $lines 0]
    foreach level $levels line [lrange $lines 1 end] {
      append result \n [string repeat "  " [- $level 1]] $line
    }
    set result [regsub -all "(\\n *)  \}" $result "\\1\}"]
    regsub -all {[^\\](?:\\\\)*\\\n} $result "&  "
  } else {
    set str
  }
}

if {[info command ::tcl::string::indent] eq ""} then {
  proc ::tcl::string::indent str {
    ::IndentString::indentStr $str
  }
  apply {
    map {
      dict set map indent ::tcl::string::indent
      namespace ensemble configure string -map $map
    }
  } [namespace ensemble configure string -map] 
}