diff options
| -rwxr-xr-x | tkread | 64 |
1 files changed, 64 insertions, 0 deletions
@@ -2,6 +2,9 @@ # Usage: tkread [-w] # -w rewrap lines # +# The markdown parsing is inspired by the code of smu: +# <https://github.com/Gottox/smu> +# # TODO: # - justify text (not simple; see http://wiki.tcl.tk/1774) # - add a basic search function @@ -13,6 +16,13 @@ set fontsize 20 set colour #333333 set inverted 0 set drag 0 +set tagnum 0 + +set surroundfmt { \ + {"***" "bold italic"} \ + {"**" "bold"} \ + {"*" "italic"} \ + } package require Tk @@ -24,12 +34,65 @@ proc rewrap {text} { return [regsub -all {\n\n\n} $better "\n"] } +# 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. +proc markup {widget} { + global surroundfmt + global fontsize + global tagnum + + foreach fmt $surroundfmt { + set searchchar [lindex $fmt 0] + set fmtstring [lindex $fmt 1] + set searchlen [string length $searchchar] + set insection 0 + set cur "" + set markonnum 0 + set markoffnum 0 + + set cur [$widget search $searchchar 0.0 end] + while {$cur != ""} { + if {$insection == 0} { + set insection 1 + $widget mark set markon_$markonnum $cur + incr markonnum + } else { + set insection 0 + $widget mark set markoff_$markoffnum $cur + incr markoffnum + } + $widget delete $cur "$cur + $searchlen chars" + + set cur [$widget search "$searchchar" $cur end] + } + + # ignore any final mismatched mark + if {$markonnum != $markoffnum } { + set markonnum $markoffnum + } + + for {set x 0} {$x < $markonnum} {incr x} { + $widget tag add tag_$tagnum markon_$x markoff_$x + } + + $widget tag configure tag_$tagnum -font "Times $fontsize $fmtstring" + incr tagnum + } +} + proc changeFontSize {change} { global fontsize + global surroundfmt + global tagnum set newsize [expr $fontsize $change] if {$newsize > 0} { set fontsize $newsize .t configure -font "Times $fontsize" -padx [expr $fontsize * 3] -spacing2 [expr [font metrics "Times $fontsize" -linespace] / 4] + for {set x 0} {$x < $tagnum} {incr x} { + set fmtstring [lindex [lindex $surroundfmt $x] 1] + .t tag configure tag_$x -font "Times $fontsize $fmtstring" + } } } @@ -69,6 +132,7 @@ if { $::argc > 0 && [lindex $::argv 0] == "-w" } { set text [rewrap $text] } .t insert end $text +markup .t .t configure -state disabled ;# disable cursor bind . <Up> {scroll -1 unit} |