Posted to tcl by hypnotoad at Fri Nov 30 23:36:05 GMT 2018view pretty

###
# Adapting from
# https://www.cl.cam.ac.uk/~mgk25/ucs/wcwidth.c
# and
# https://github.com/jquast/wcwidth/blob/master/wcwidth/wcwidth.py
# to work in pure tcl
###
namespace eval ::wcswidth {
  set ::wcswidth::ranges(0) {}
  set ::wcswidth::ranges(-1) {}
  set ::wcswidth::ranges(2) {}

  foreach {length start end} {
    0 0 0             -1 1 31           -1 0x7f 0xbf
    0 0x0300 0x036F   0 0x0483 0x0486   0 0x0488 0x0489
    0 0x0591 0x05BD   0 0x05BF 0x05BF   0 0x05C1 0x05C2
    0 0x05C4 0x05C5   0 0x05C7 0x05C7   0 0x0600 0x0603
    0 0x0610 0x0615   0 0x064B 0x065E   0 0x0670 0x0670
    0 0x06D6 0x06E4   0 0x06E7 0x06E8   0 0x06EA 0x06ED
    0 0x070F 0x070F   0 0x0711 0x0711   0 0x0730 0x074A
    0 0x07A6 0x07B0   0 0x07EB 0x07F3   0 0x0901 0x0902
    0 0x093C 0x093C   0 0x0941 0x0948   0 0x094D 0x094D
    0 0x0951 0x0954   0 0x0962 0x0963   0 0x0981 0x0981
    0 0x09BC 0x09BC   0 0x09C1 0x09C4   0 0x09CD 0x09CD
    0 0x09E2 0x09E3   0 0x0A01 0x0A02   0 0x0A3C 0x0A3C
    0 0x0A41 0x0A42   0 0x0A47 0x0A48   0 0x0A4B 0x0A4D
    0 0x0A70 0x0A71   0 0x0A81 0x0A82   0 0x0ABC 0x0ABC
    0 0x0AC1 0x0AC5   0 0x0AC7 0x0AC8   0 0x0ACD 0x0ACD
    0 0x0AE2 0x0AE3   0 0x0B01 0x0B01   0 0x0B3C 0x0B3C
    0 0x0B3F 0x0B3F   0 0x0B41 0x0B43   0 0x0B4D 0x0B4D
    0 0x0B56 0x0B56   0 0x0B82 0x0B82   0 0x0BC0 0x0BC0
    0 0x0BCD 0x0BCD   0 0x0C3E 0x0C40   0 0x0C46 0x0C48
    0 0x0C4A 0x0C4D   0 0x0C55 0x0C56   0 0x0CBC 0x0CBC
    0 0x0CBF 0x0CBF   0 0x0CC6 0x0CC6   0 0x0CCC 0x0CCD
    0 0x0CE2 0x0CE3   0 0x0D41 0x0D43   0 0x0D4D 0x0D4D
    0 0x0DCA 0x0DCA   0 0x0DD2 0x0DD4   0 0x0DD6 0x0DD6
    0 0x0E31 0x0E31   0 0x0E34 0x0E3A   0 0x0E47 0x0E4E
    0 0x0EB1 0x0EB1   0 0x0EB4 0x0EB9   0 0x0EBB 0x0EBC
    0 0x0EC8 0x0ECD   0 0x0F18 0x0F19   0 0x0F35 0x0F35
    0 0x0F37 0x0F37   0 0x0F39 0x0F39   0 0x0F71 0x0F7E
    0 0x0F80 0x0F84   0 0x0F86 0x0F87   0 0x0F90 0x0F97
    0 0x0F99 0x0FBC   0 0x0FC6 0x0FC6   0 0x102D 0x1030
    0 0x1032 0x1032   0 0x1036 0x1037   0 0x1039 0x1039
    0 0x1058 0x1059   0 0x1160 0x11FF   0 0x135F 0x135F
    0 0x1712 0x1714   0 0x1732 0x1734   0 0x1752 0x1753
    0 0x1772 0x1773   0 0x17B4 0x17B5   0 0x17B7 0x17BD
    0 0x17C6 0x17C6   0 0x17C9 0x17D3   0 0x17DD 0x17DD
    0 0x180B 0x180D   0 0x18A9 0x18A9   0 0x1920 0x1922
    0 0x1927 0x1928   0 0x1932 0x1932   0 0x1939 0x193B
    0 0x1A17 0x1A18   0 0x1B00 0x1B03   0 0x1B34 0x1B34
    0 0x1B36 0x1B3A   0 0x1B3C 0x1B3C   0 0x1B42 0x1B42
    0 0x1B6B 0x1B73   0 0x1DC0 0x1DCA   0 0x1DFE 0x1DFF
    0 0x200B 0x200F   0 0x202A 0x202E   0 0x2060 0x2063
    0 0x206A 0x206F   0 0x20D0 0x20EF   0 0x302A 0x302F
    0 0x3099 0x309A   0 0xA806 0xA806   0 0xA80B 0xA80B
    0 0xA825 0xA826   0 0xFB1E 0xFB1E   0 0xFE00 0xFE0F
    0 0xFE20 0xFE23   0 0xFEFF 0xFEFF   0 0xFFF9 0xFFFB
    0 0x10A01 0x10A03   0 0x10A05 0x10A06   0 0x10A0C 0x10A0F
    0 0x10A38 0x10A3A   0 0x10A3F 0x10A3F   0 0x1D167 0x1D169
    0 0x1D173 0x1D182   0 0x1D185 0x1D18B   0 0x1D1AA 0x1D1AD
    0 0x1D242 0x1D244   0 0xE0001 0xE0001   0 0xE0020 0xE007F
    0 0xE0100 0xE01EF
  } {
    lappend ::wcswidth::ranges($length) $start $end
  }

  foreach {start end comment} {
    0x1100 0x115f {CJK ... Yi}
    0x2329 0x2329 {Hangul Jamo init. consonant}
    0x232a 0x232a {Hangul Jamo init. consonant}
    0x2e80 0x303e {CJK ... Yi}
    0x3040 0xa4cf {CJK ... Yi}
    0xac00 0xd7a3 {Hangul Syllables}
    0xf900 0xfaff {CJK Compatibility Ideographs}
    0xfe10 0xfe19 {Vertical forms}
    0xfe30 0xfe6f {CJK Compatibility Forms}
    0xff00 0xff60 {Fullwidth Forms}
    0xffe0 0xffe6 {Fullwidth Forms}
    0x20000 0x2fffd {Fullwidth Forms}
    0x30000 0x3fffd {Fullwidth Forms}
  } {
    lappend ::wcswidth::ranges(2) $start $end
  }
}
proc ::wcswidth::charwidth {char} {
  variable ranges
  foreach width {-1 0 2} {
    foreach {start end} $ranges($width) {
      if {$char >= $start && $char <= $end} {
        return $width
      }
    }
  }
  return 1
}

proc wcswidth {string} {
  set width 0
  set len [string length $string]
  for {set i 0} {$i < $len} {incr i} {
    scan [string index $string $i] %c char
    set n [::wcswidth::charwidth $char]
    if {$n < 0} {
      return -1
    }
    incr width $n
  }
  return $width
}