string indent

Das Paket StringIndent erweitert das Kommandoensemble string um den Unterbefehl indent.

Das Kommando string indent $src übergibt eine Zeichenkette mit sauberer Einrückung entlang Geschweifer Klammern und Gänsefüßchen, falls möglich:

% package require IndentString
0.2
% string indent [.t get 1.0 end-1chars]
proc unbind args {
  foreach event {<Button-1>
                 <Double-Button-1>
                 <Shift-Button-1>
                 <B1-Motion>
                 <Triple-Button-1>} {
    bind .t $event ""
  }
}
%

Wenn auf eine öffnende Schweifklammer nicht unmittelbar ein Zeilenwechsel folgt, werden die Folgezeilen bis zur schließenden Schweifklammer bündig angeordnet. Wer das nicht will, benutzt den Schalter -nocosmetics wie hier:

% string indent -nocosmetics [.t get 1.0 end-1chars]
proc unbind args {
  foreach event {<Button-1>
    <Double-Button-1>
    <Shift-Button-1>
    <B1-Motion>
    <Triple-Button-1>} {
    bind .t $event ""
  }
}
%

Eckige und runde Klammern werden – soweit ordentlich balanciert – berücksichtigt wie Schweifklammern. Um dies zu unterdrücken, dienen die Schalter -noparens und -nobrackets. Unzweideutige Abkürzungen sind möglich.

Falls die Zeichenfolge nicht sinnvoll eingerückt werden kann, wird sie unverändert zurückgegeben.


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

package require Tcl 8.6.1
package provide IndentString 0.2

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+1]
  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 {
  if {[string index $src 0] eq "\{"} then {
    set char "\}"
  } else {
    set char \"
  }
  set li [split $src ""]
  set indices [lsearch -exact -all $li $char]
  foreach length $indices {
    if {[info complete [string range $src 0 $length]]} break
    set length -1
  }
  set length
}

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::doIndentString {str args} {
  set str1 $str
  if {"-nobrackets" ni $args} then {
    set strBrackets [string map [list \[ \{ \] \}] $str1]
    if {[info complete $strBrackets]} then {
      set str1 $strBrackets
    }
  }
  if {"-noparens" ni $args} then {
    # string indent -noparens $str
    set strParens [string map [list ( \{ ) \}] $str1]
    if {[info complete $strParens]} then {
      set str1 $strParens
    }
  }
  #
  set li\
    [splitByLevels\
      [string map\
        [list \\\\ __ \\\n "_\n" {\"} {{"}}]\
        $str1]]
  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
  }
  cosmetics $result {*}$args
}

proc IndentString::indentStr {str args} {
  foreach arg $args {
    if {[string index $arg] ne "-" ||
      $arg in {- -n -no}} then {
      return -code error "bad option $arg\nstring indent [lrange [info level 1] 1 end]"
    } else {
      set idx [lsearch {-nobrackets -noparens -nocosmetics} $arg*]
      if {$idx < 0} then {
        return -code error "bad option $arg\nstring indent [lrange [info level 1] 1 end]"
      } elseif {[string match $arg* -nobrackets]} then {
        lset args $idx -nobrackets
      } elseif {[string match $arg* -noparens]} then {
        lset args $idx -noparens
      } elseif {[string match $arg* -nocosmetics]} then {
        lset args $idx -nocosmetics
      } 
    }
  }
  if {![info complete $str]} then {
    set str
  } elseif {![catch {
      set result [doIndentString $str {*}$args]
    } err]} then {
    set result
  } else {
    doIndentString $str -noparens -nobrackets {*}$args
  }
}

proc IndentString::cosmetics {str args} {
  # unindent closing brace
  set str [regsub -all "(\\n *)  \}" $str "\\1\}"]
  # indent backslashed line continuations
  set str [regsub -all {[^\\](?:\\\\)*\\\n} $str "&  "]
  # {[lsearch $args -noc*] >= 0}
  if {"-nocosmetics" ni $args} then {
    # switch -nocosmetis given
    set str
  } else {
    # align "... {apfel
                # birne
                # citrone}"
    alignBrace $str
  }
}

proc IndentString::alignBrace str {
  set pat {\n[^\n]*[{][^\s\}][^{}]+\n[^{}]+[}]}
  if {[regexp -indices $pat $str range]} then {
    lassign $range start end
    set head [string range $str 0 $start]
    set body [string range $str $start+1 $end]
    set foot [string range $str $end+1 end]
    #
    set lines [split $body \n]
    set line0 [lindex $lines 0]
    set length [string last \u007b $line0]
    set dist [string repeat " " $length]
    set linesRest\
      [lmap x [lrange $lines 1 end] {
      set x " $dist[string trimleft $x]"
    }]
    append result $head $line0 \n [join $linesRest \n] $foot
  } else {
    set str
  }
}

if {[info command ::tcl::string::indent] eq ""} then {
  proc ::tcl::string::indent args {
    ::IndentString::indentStr [lindex $args end] {*}[lrange $args 0 end-1]
  }
  apply {
    map {
      dict set map indent ::tcl::string::indent
      namespace ensemble configure string -map $map
    }
  } [namespace ensemble configure string -map] 
}

11.3.2022