diff options
| -rwxr-xr-x | tkread | 40 |
1 files changed, 40 insertions, 0 deletions
@@ -1,4 +1,6 @@ #!/usr/bin/tclsh +# Requires Tk and Img packages (tk and libtk-img in Debian) +# # Copyright 2013-2014 Nick White <njw.me.uk>, released under the ISC License # # Permission to use, copy, modify, and/or distribute this software for any @@ -50,6 +52,7 @@ if { $::argc > 0 && [lindex $::argv 0] == "-h" } { } package require Tk +package require Img proc rewrap {text} { set wrapped [regsub -all {\n([^\n])} $text { \1}] @@ -59,6 +62,14 @@ proc rewrap {text} { return [regsub -all {\n\n\n} $better "\n"] } +# Moves char part of a text widget index (linenum.charnum) +proc indexmovechar {str moveby} { + set dotindex [string first . $str] + set charnum [string range $str [expr $dotindex + 1] end] + set linenum [string range $str 0 [expr $dotindex - 1]] + return $linenum.[expr $charnum $moveby] +} + # This uses marks before tags, as they handle deletions fine, so # marks can be made and then the formatting characters can be # deleted without affecting the position for formatting. @@ -68,6 +79,7 @@ proc markup {widget} { global fontsize global tagnum + # process surrounds (bold, italic, and some headers) foreach fmt $surroundfmt { set searchchar [lindex $fmt 0] set fmtsizemod [lindex $fmt 1] @@ -107,6 +119,34 @@ proc markup {widget} { $widget tag configure tag_$tagnum -font "{$fontfamily} [expr $fontsize + $fmtsizemod] $fmtstring" incr tagnum } + + # process images + set cur [$widget search {![} 0.0 end] + while {$cur != ""} { + set altstart [indexmovechar $cur "+ 2"] + set cur [$widget search "](" $cur end] + if {$cur == ""} { break } + set altend $cur + set srcstart [indexmovechar $cur "+ 2"] + set cur [$widget search ")" $cur end] + if {$cur == ""} { break } + set srcend $cur + + set alt [$widget get $altstart $altend] + set src [$widget get $srcstart $srcend] + + $widget delete [indexmovechar $altstart "- 2"] [indexmovechar $srcend "+ 1"] + set insertion [indexmovechar $altstart "- 2"] + set localfile [file tail $src] + if [file exists $localfile] { + set curimg [image create photo -file $localfile] + $widget image create $insertion -image $curimg + } else { + $widget insert [indexmovechar $insertion "- 2"] $alt + } + + set cur [$widget search {![} $cur end] + } } proc changeFontSize {change} { |