Version 2 of Small caps

if 0 {Richard Suchenwirth 2004-08-20 - "Small Caps" is a typesetting style in which each letter is set with an uppercase glyph, but the logical "lowercases" are in a smaller point size, like 60..80 % of the logical "uppercase" letters. Here's my take to implement them for Tk's text widget. You specify the widget, the position where to insert (I often use "end" there), the text itself, and optionally a font, and a smallness percentage (defaults to 67%).

I noticed that on Win95 with Tcl 8.4.5, the default font for text widgets {{MS Sans Serif]} 8} is not rendered smaller to 5 pt, even if specified. So better give an explicit font if the smallcapping doesn't seem to work... Also, for i18n, you might extend the regular expression re below, but the Wiki often defaces umlauts pretty badly, so I left them out for now.

(Couldn't you use [[:upper:]]] in place of [A-Z]? ISTR that character classes handle umlauts etc. (in a locale specific way?) - I would test in a tkcon here, but I don't actually know how to persuade my keyboard to produce an umlauted char! --MNO) }

 proc smallcaps {w index text {font ""} {smallness 67}} {
    if {$font eq ""} {set font [$w cget -font]}
    set bigtag [string map {" " _ \{ _ \} _} $font]
    $w tag configure $bigtag -font $font

    set bigsize   [lindex $font 1]
    set smallsize [expr {round($bigsize*$smallness/100.)}]
    set smallfont [lreplace $font 1 1 $smallsize]
    set smalltag  [string map {" " _ \{ _ \} _} $smallfont]
    $w tag configure $smalltag -font $smallfont

    set cmd [list $w insert $index]
    set re {([A-Z]*)([^A-Z]*)}
    foreach {- big small} [regexp -all -inline $re $text] {
        lappend cmd $big $bigtag [string toupper $small] $smalltag
    }
    eval $cmd
 }

#-- Testing:

 pack [text .t]
 smallcaps .t end "Testing SmallCaps..\n\n" {Times 12}
 .t insert end "This is normal text, in comparison"

Arts and crafts of Tcl-Tk programming