Bryan Oakley writes, on comp.lang.tcl, :
Geoffrey King wrote: > Larry, you would be right. In a phrase i would like "simple MS Word" > style editing or "HTML editing" might be better. It would have : font > variations, tables, bullet points, inline images, nestings of the above. > Any more is a bonus. From the posts I suspect that meagre list will be > hard to find.
I'm pretty certain no megawidget exists that does that. However, it's honestly not that hard to write your own given what's built in to the text widget already. Tables and embedded images would be the only thing remotely hard (flowing around images, for example, can't be done). If you just want to be able to pick fonts, colors, text size and alignment, bullets, etc., that stuff is easy.
As a starting point, here's some code that shows one way to implement a bold and italic button. It's not complete, but it illustrates how to intercept text insertions and apply any tags that you want.
First, a simple megawidget (pure tcl, no megawidget package required!) that adds a new "tags" command to the text widget, and code to apply those tags to all newly inserted text (here's hoping line boundaries don't get screwed up as it passes through the ether!):
package require Tcl 8.5
namespace eval rtext {
namespace eval instance {}
}
proc rtext::rtext {path args} {
upvar \#0 [namespace current]::data-$path data
set data(tags) ""
set data(actual) [namespace current]::instance::$path
text $path
rename $path $data(actual)
interp alias \
{} $path \
{} [namespace which -command widgetProxy] $path
eval $data(actual) configure $args
return $path
}
# this gets called instead of the actual widget
# command. Mostly it passes things through to the
# actual widget, but "insert" and a new "tags"
# command are treated specially. You could use
# the "wcb" package to accomplish the same thing.
proc rtext::widgetProxy {path cmd args} {
upvar \#0 [namespace current]::data-$path data
if {$cmd eq "insert"} {
# for each block of text being inserted, add the list of
# current tags to the list of tags to be applied to the block
set statement [list $data(actual) insert [lindex $args 0]]
foreach {string tags} [lrange $args 1 end] {
lappend statement $string [concat $tags $data(tags)]
}
set result [uplevel $statement]
} elseif {$cmd eq "tags"} {
# usage: $path tags ?tag ?tag ...??
# if tags are given, apply the tags to any new text that is
# inserted
if {[llength $args] > 0} {
set data(tags) $args
}
set result $data(tags)
} else {
set result [uplevel [concat [list $data(actual) $cmd] $args]]
}
return $result
}Next, here's a little test program that creates an instance of the widget along with two toolbar buttons for bold and italic so you see how you would tie toolbar buttons to the new widget. Expanding the above to do underline, overstrike, text alignment, etc should be fairly straight-forward. Just create tags for every attribute you want on the toolbar and lather, rinse, repeat.
package require Tk
global style
frame .tb -borderwidth 2 -relief groove
rtext::rtext .rtext \
-wrap word \
-yscrollcommand [list .vsb set]
scrollbar .vsb -command [list .rtext yview]
pack .tb -side top -fill x
pack .vsb -side right -fill y
pack .rtext -side bottom -fill both -expand true
font create boldFont \
-family Helvetica -weight bold
font create italicFont \
-family Helvetica -slant italic
font create boldItalicFont \
-family Helvetica -weight bold -slant italic
font create normalFont \
-family Helvetica
checkbutton .tb.bold \
-indicatoron false -text "B" -bd 1 \
-command [list toggleStyles .rtext] \
-variable style(bold) -font boldFont \
-onvalue 1 -offvalue 0
checkbutton .tb.italic \
-indicatoron false -text "I" -bd 1 \
-command [list toggleStyles .rtext] \
-variable style(italic) -font italicFont \
-onvalue 1 -offvalue 0 -font italicFont
pack .tb.bold .tb.italic -side left
set style(bold) 0
set style(italic) 0
.rtext tag configure normal -font normalFont
.rtext tag configure italic -font italicFont
.rtext tag configure bold -font boldFont
.rtext tag configure boldItalic -font boldItalicFont
.rtext tags "normal"
proc ::toggleStyles {w} {
global style
set tags {}
if {$style(bold)} {lappend tags bold}
if {$style(italic)} {lappend tags italic}
if {$style(bold) && $style(italic)} {lappend tags boldItalic}
if {[llength $tags] == 0} {set tags [list "normal"]}
eval \$w tags $tags
# if there is a selection, apply the current styles to the selection
set sel [$w tag ranges sel]
if {[llength $sel] > 0} {
foreach {start end} $sel {
# this could be generalized, but it's good enough
# for this example..
$w tag remove bold $start $end
$w tag remove italic $start $end
$w tag remove boldItalic $start $end
$w tag remove normal $start $end
foreach tag $tags {
$w tag add $tag $start $end
}
}
}
}Bryan Oakley http://www.tclscripting.com