info
Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
ISO conversion tool for text widgets
95 views
Skip to first unread message
Helmut Giese
Sep 3, 2021, 3:23:45 PM9/3/21
to
Hello out there,
wanting to display text in a text widget which is partly italic and /
or bold I am wondering if there is a light weight conversion tool
which converts text like
This is normal text while this is in <i>italic</i>
(or with any other annotation) into the proper text widget 's
pathname tag configure ...
commands?
Any link or tip will be greatly appreciated
Helmut
wanting to display text in a text widget which is partly italic and /
or bold I am wondering if there is a light weight conversion tool
which converts text like
This is normal text while this is in <i>italic</i>
(or with any other annotation) into the proper text widget 's
pathname tag configure ...
commands?
Any link or tip will be greatly appreciated
Helmut
Dave
Sep 3, 2021, 3:54:33 PM9/3/21
to
>
> # Return the text widget tag for html italic or bold text
> #
> proc tag {ib} {
> switch -exact $ib {
> i {
> return tagCaptionItalic
> }
> b {
> return tagCaptionBold
> }
> default {
> return ""
> }
> }
> }
>
> # Replace any html character entities with the literal character
> #
> proc unHtml {text} {
> regsub -all {&?} $text {\&} text
> regsub -all {<?} $text {<} text
> regsub -all {>?} $text {>} text
> regsub -all {¢?} $text "\u00a2" text
> regsub -all {"?} $text {"} text
> regsub -all {'?} $text {'} text
> regsub -all { ?} $text "\u00a0" text
> return $text
> }
>
> # Scan a html text string and break it into {text tag} pairs for
insertion
> # into the text widget for the caption. The only html tags
supported are
> # <i>...</i> and <b>...</b> and they cannot be nested
> #
> proc tagify {string} {
>
> set text [list ]
>
> set ranges [regexp -all -indices -inline
{<{1,1}?([ib])\s*>(.*?)</\1\s*>} $string]
>
> set cursor 0
>
> foreach {whole tag content} $ranges {
>
> lassign $whole s e
>
> if { $s > $cursor } {
> lappend text [unHtml [string range $string $cursor $s-1]] ""
> }
>
> lappend text [unHtml [string range $string {*}$content]] [tag
[string index $string [lindex $tag 0]]]
>
> set cursor [expr {$e+1}]
> }
>
> if { $cursor < [string length $string] } {
> lappend text [unHtml [string range $string $cursor end]] ""
> }
>
> return $text
> }
>
> #
> # Derive and create fonts
> #
>
> array set Constants [list ]
>
> set size [font configure TkCaptionFont -size]
>
> # The fonts for the caption window
> set Constants(captionFont) [eval \
> font create [font configure TkCaptionFont] -size [incrFontSize
$size 2]]
> set Constants(captionBoldFont) [eval \
> font create [font configure TkCaptionFont] -size [incrFontSize
$size 2] \
> -weight bold]
> set Constants(captionItalicFont) [eval \
> font create [font configure TkCaptionFont] -size [incrFontSize
$size 2] \
> -slant italic]
> set Constants(captionMeasure) [font measure $Constants(captionFont) 0]
>
> unset size
>
>
> proc whatever ... {
> :
> :
> :
>
> # Insert the caption after replacing any html character
entities and
> # using an italic or bold font for <i> or <b> html tags
> if { [string length $caption] > 0 } {
>
> text $w.caption -font $Constants(captionFont) \
> -borderwidth 0 \
> -background white \
> -height 1 \
> -width [expr { ([image width image$id] - 50)
/ $Constants(captionMeasure) }] \
> -relief flat \
> -wrap word
>
> $w.caption tag config tagJustify -justify center
> $w.caption tag config tagCaptionItalic -font
$Constants(captionItalicFont)
> $w.caption tag config tagCaptionBold -font
$Constants(captionBoldFont)
>
> foreach {text tag} [tagify $caption] {
> $w.caption insert end $text $tag
> }
>
> $w.caption tag add tagJustify 0.0 end
>
> pack $w.caption -side top \
> -pady {0 5}
>
> :
> :
> :
> }
--
computerjock AT mail DOT com
Dave
Sep 3, 2021, 3:58:27 PM9/3/21
to
On 9/3/2021 2:23 PM, Helmut Giese wrote:
> # Do arithmetic on a font size
> # If the font size is positive, the size is measured in points
> # If the font size is negative, the size is measured in pixels
> proc incrFontSize {size delta} {
> if { $size >= 0 } {
> incr size $delta
> } else {
> # tk scaling is the number of pixels/point
> set size [expr {$size - round([tk scaling] * $delta)}]
> }
> return $size
Helmut Giese
Sep 4, 2021, 6:35:28 AM9/4/21
to
Hi Dave,
many thanks for your code, it sems to be what I was looking for.
Looking at the time stamp of your posting I could have waited online
for it to arrive. :)
Thanks again
Helmut
many thanks for your code, it sems to be what I was looking for.
Looking at the time stamp of your posting I could have waited online
for it to arrive. :)
Thanks again
Helmut
Alex Plotnikov
Sep 5, 2021, 11:48:22 PM9/5/21
to
Probably a bit late, still I would like to share with a code I use.
Its main feature is that it doesn't use RE, but string commands only.
The code is rather old, don't judge it too strictly:)
For its test below:
There two texts - normal and disabled. The disabled becomes normal after 10 sec.
#==================================================================
proc resetText {w state {contsName {}}} {
# Resets a text widget to edit/view from scratch.
# w - text widget's name
# state - widget's final state (normal/disabled)
# contsName - variable name for contents to be set in the widget
if {$contsName ne {}} {
upvar 1 $contsName conts
$w replace 1.0 end $conts
}
$w edit reset; $w edit modified no
$w configure -state $state
}
proc displayTaggedText {w contsName {tags ""}} {
# Sets the text widget's contents using tags (ornamental details).
# w - text widget's name
# contsName - variable name for contents to be set in the widget
# tags - list of tags to be applied to the text
#
# The lines in *text contents* are divided by \n and can include
# *tags* like in a html layout, e.g. <red>RED ARMY</red>.
#
# The *tags* is a list of "name/value" pairs. 1st is a tag's name, 2nd
# is a tag's value.
#
# The tag's name is "pure" one (without <>) so e.g.for <b>..</b> the tag
# list contains "b".
#
# The tag's value is a string of text attributes (-font etc.).
upvar 1 $contsName conts
if { [set state [$w cget -state]] ne {normal}} {
$w configure -state normal
}
if {$tags eq {}} {
resetText $w $state conts
return
}
set taglist [set tagpos [set taglen [list]]]
foreach tagi $tags {
lassign $tagi tag opts
$w tag configure $tag {*}$opts
lappend tagpos 0
lappend taglen [string length $tag]
}
set tLen [llength $tags]
set disptext {}
set irow 1
foreach line [split $conts \n] {
if {$irow > 1} {
append disptext \n
}
set newline {}
while 1 {
set p [string first \< $line]
if {$p < 0} {
break
}
append newline [string range $line 0 $p-1]
set line [string range $line $p end]
set i 0
set nrnc $irow.[string length $newline]
foreach tagi $tags pos $tagpos len $taglen {
lassign $tagi tag
if {[string first "\<$tag\>" $line]==0} {
if {$pos ne {0}} {
error "Mismatched \<$tag\> in line $irow"
}
lset tagpos $i $nrnc
set line [string range $line $len+2 end]
break
} elseif {[string first "\</$tag\>" $line]==0} {
if {$pos eq {0}} {
error "Mismatched \</$tag\> in line $irow"
}
lappend taglist [list $i $pos $nrnc]
lset tagpos $i 0
set line [string range $line $len+3 end]
break
}
incr i
}
if {$i == $tLen} {
# tag not found after "<" - shift by 1 character
append newline [string index $line 0]
set line [string range $line 1 end]
}
}
append disptext $newline $line
incr irow
}
resetText $w $state disptext
set lfont [$w cget -font]
catch {set lfont [font actual $lfont]}
for {set it [llength $taglist]} {[incr it -1]>=0} {} {
set tagli [lindex $taglist $it]
lassign $tagli i p1 p2
lassign [lindex $tags $i] tag opts
$w tag add $tag $p1 $p2
}
}
#==================================================================
# Test
set textTags [list \
[list "red" " -font {-weight bold} -foreground white -background red"] \
[list "i" " -font {-weight bold -slant italic} -foreground red"] \
[list "inv" " -font {-weight bold} -foreground blue -background white"] \
]
set text "
<red>resetText</red>:
Sets the text widget's contents using tags (ornamental details).
<i>Synopsis:</i>
<inv>displayTaggedText {w contsName {tags {}}}</inv>
<inv>w</inv> - text widget's name
<inv>contsName</inv> - variable name for contents to be set in the widget
<inv>tags</inv> - list of tags to be applied to the text
The lines in <inv>text contents</inv> are divided by \\n and can include
<inv>tags</inv> like in a html layout, e.g. <red>RED ARMY</red>.
"
package require Tk
text .tnormal -height 16
text .tdisabled -height 16 -state disabled
displayTaggedText .tnormal text $textTags
displayTaggedText .tdisabled text $textTags
pack .tnormal
pack .tdisabled
after 10000 "::resetText .tdisabled normal; puts {.tdisabled's state is normal}"
Its main feature is that it doesn't use RE, but string commands only.
The code is rather old, don't judge it too strictly:)
For its test below:
There two texts - normal and disabled. The disabled becomes normal after 10 sec.
#==================================================================
proc resetText {w state {contsName {}}} {
# Resets a text widget to edit/view from scratch.
# w - text widget's name
# state - widget's final state (normal/disabled)
# contsName - variable name for contents to be set in the widget
if {$contsName ne {}} {
upvar 1 $contsName conts
$w replace 1.0 end $conts
}
$w edit reset; $w edit modified no
$w configure -state $state
}
proc displayTaggedText {w contsName {tags ""}} {
# Sets the text widget's contents using tags (ornamental details).
# w - text widget's name
# contsName - variable name for contents to be set in the widget
# tags - list of tags to be applied to the text
#
# The lines in *text contents* are divided by \n and can include
# *tags* like in a html layout, e.g. <red>RED ARMY</red>.
#
# The *tags* is a list of "name/value" pairs. 1st is a tag's name, 2nd
# is a tag's value.
#
# The tag's name is "pure" one (without <>) so e.g.for <b>..</b> the tag
# list contains "b".
#
# The tag's value is a string of text attributes (-font etc.).
upvar 1 $contsName conts
if { [set state [$w cget -state]] ne {normal}} {
$w configure -state normal
}
if {$tags eq {}} {
resetText $w $state conts
return
}
set taglist [set tagpos [set taglen [list]]]
foreach tagi $tags {
lassign $tagi tag opts
$w tag configure $tag {*}$opts
lappend tagpos 0
lappend taglen [string length $tag]
}
set tLen [llength $tags]
set disptext {}
set irow 1
foreach line [split $conts \n] {
if {$irow > 1} {
append disptext \n
}
set newline {}
while 1 {
set p [string first \< $line]
if {$p < 0} {
break
}
append newline [string range $line 0 $p-1]
set line [string range $line $p end]
set i 0
set nrnc $irow.[string length $newline]
foreach tagi $tags pos $tagpos len $taglen {
lassign $tagi tag
if {[string first "\<$tag\>" $line]==0} {
if {$pos ne {0}} {
error "Mismatched \<$tag\> in line $irow"
}
lset tagpos $i $nrnc
set line [string range $line $len+2 end]
break
} elseif {[string first "\</$tag\>" $line]==0} {
if {$pos eq {0}} {
error "Mismatched \</$tag\> in line $irow"
}
lappend taglist [list $i $pos $nrnc]
lset tagpos $i 0
set line [string range $line $len+3 end]
break
}
incr i
}
if {$i == $tLen} {
# tag not found after "<" - shift by 1 character
append newline [string index $line 0]
set line [string range $line 1 end]
}
}
append disptext $newline $line
incr irow
}
resetText $w $state disptext
set lfont [$w cget -font]
catch {set lfont [font actual $lfont]}
for {set it [llength $taglist]} {[incr it -1]>=0} {} {
set tagli [lindex $taglist $it]
lassign $tagli i p1 p2
lassign [lindex $tags $i] tag opts
$w tag add $tag $p1 $p2
}
}
#==================================================================
# Test
set textTags [list \
[list "red" " -font {-weight bold} -foreground white -background red"] \
[list "i" " -font {-weight bold -slant italic} -foreground red"] \
[list "inv" " -font {-weight bold} -foreground blue -background white"] \
]
set text "
<red>resetText</red>:
Sets the text widget's contents using tags (ornamental details).
<i>Synopsis:</i>
<inv>displayTaggedText {w contsName {tags {}}}</inv>
<inv>w</inv> - text widget's name
<inv>contsName</inv> - variable name for contents to be set in the widget
<inv>tags</inv> - list of tags to be applied to the text
The lines in <inv>text contents</inv> are divided by \\n and can include
<inv>tags</inv> like in a html layout, e.g. <red>RED ARMY</red>.
"
package require Tk
text .tnormal -height 16
text .tdisabled -height 16 -state disabled
displayTaggedText .tnormal text $textTags
displayTaggedText .tdisabled text $textTags
pack .tnormal
pack .tdisabled
after 10000 "::resetText .tdisabled normal; puts {.tdisabled's state is normal}"
Bezoar
Sep 14, 2021, 2:18:06 PM9/14/21
to
just following the chain . this seems a little simpler
#!/bin/sh
# the next line restarts using wish \
exec /opt/usr8.6.3/bin/tclsh8.6 "$0" ${1+"$@"}
proc push { q item } {
upvar $q queue
lappend queue $item
}
proc peek { q } {
upvar $q queue
return [lindex $queue end ]
}
proc pop { q } {
upvar $q queue
set retval [lindex $queue end ]
set queue [ lreplace $queue end end ]
return $retval;
}
proc process { buffer } {
set retval [list]
set done 0
set prevchar ""
set mode text
set tagqueue [list]
set tagname ""
set level 0
set outbuffer ""
foreach c [split $buffer "" ] {
switch -exact -- $c {
"/" {
if { "$prevchar$c" eq "</" } {
set mode endtag
}
}
"<" {
if { $mode in { "tag" "endtag" } } {
append outbuffer "<$tagname"
set tagname ""
} else {
if { [string length $outbuffer] } {
lappend retval [list $outbuffer $tagqueue ]
}
set outbuffer ""
}
set mode tag
}
">" {
if { $mode eq "tag" } {
push tagqueue $tagname
set tagname ""
} elseif { $mode eq "endtag" } {
set t [peek tagqueue ]
if { $t eq $tagname } {
if { [string length $outbuffer] } {
lappend retval [list $outbuffer $tagqueue ]
}
pop tagqueue
set tagname ""
} else {
error " nesting error "
}
set outbuffer ""
} else {
append outbuffer $c
}
set mode text
}
default {
if { $mode in { "tag" "endtag" } } {
append tagname $c
} else {
append outbuffer $c
}
}
}
set prevchar $c
}
if { [string length $outbuffer] } {
lappend retval $outbuffer $tagname
}
return $retval
}
package require Tk
set example {<h1>The Example</h1>
<h2><u>The Rain</u></h2>
the <i>rain</i> in spain > falls mainly in <x>the <i><b>plain</b></i></x>}
text .text -width 80 -height 10 -bg black -fg white -font { Courier 10 }
.text tag configure x -overstrike 1
.text tag configure u -underline 1
.text tag configure h1 -font { Helvetica 20 }
.text tag configure h2 -font { Helvetica 15 }
.text tag configure i -font { Helvetica 12 italic }
.text tag configure b -font { Helvetica 12 bold } -background red
pack .text
foreach segment [ process $example ] {
lassign $segment text tags
.text insert end $text $tags
}
#!/bin/sh
# the next line restarts using wish \
exec /opt/usr8.6.3/bin/tclsh8.6 "$0" ${1+"$@"}
proc push { q item } {
upvar $q queue
lappend queue $item
}
proc peek { q } {
upvar $q queue
return [lindex $queue end ]
}
proc pop { q } {
upvar $q queue
set retval [lindex $queue end ]
set queue [ lreplace $queue end end ]
return $retval;
}
proc process { buffer } {
set retval [list]
set done 0
set prevchar ""
set mode text
set tagqueue [list]
set tagname ""
set level 0
set outbuffer ""
foreach c [split $buffer "" ] {
switch -exact -- $c {
"/" {
if { "$prevchar$c" eq "</" } {
set mode endtag
}
}
"<" {
if { $mode in { "tag" "endtag" } } {
append outbuffer "<$tagname"
set tagname ""
} else {
if { [string length $outbuffer] } {
lappend retval [list $outbuffer $tagqueue ]
}
set outbuffer ""
}
set mode tag
}
">" {
if { $mode eq "tag" } {
push tagqueue $tagname
set tagname ""
} elseif { $mode eq "endtag" } {
set t [peek tagqueue ]
if { $t eq $tagname } {
if { [string length $outbuffer] } {
lappend retval [list $outbuffer $tagqueue ]
}
pop tagqueue
set tagname ""
} else {
error " nesting error "
}
set outbuffer ""
} else {
append outbuffer $c
}
set mode text
}
default {
if { $mode in { "tag" "endtag" } } {
append tagname $c
} else {
append outbuffer $c
}
}
}
set prevchar $c
}
if { [string length $outbuffer] } {
lappend retval $outbuffer $tagname
}
return $retval
}
package require Tk
set example {<h1>The Example</h1>
<h2><u>The Rain</u></h2>
the <i>rain</i> in spain > falls mainly in <x>the <i><b>plain</b></i></x>}
text .text -width 80 -height 10 -bg black -fg white -font { Courier 10 }
.text tag configure x -overstrike 1
.text tag configure u -underline 1
.text tag configure h1 -font { Helvetica 20 }
.text tag configure h2 -font { Helvetica 15 }
.text tag configure i -font { Helvetica 12 italic }
.text tag configure b -font { Helvetica 12 bold } -background red
pack .text
foreach segment [ process $example ] {
lassign $segment text tags
.text insert end $text $tags
}
Christian Gollwitzer
Sep 14, 2021, 4:42:49 PM9/14/21
to
Am 14.09.21 um 20:18 schrieb Bezoar:
parser for the text widget. I use it in a few programs to show rich text
in an easy way.
Kevin Walzer seems to have pulled it from the web, unfortunately, but
the wayback machine still has it:
https://web.archive.org/web/20100129063119/http://www.codebykevin.com/opensource/xplat_oss.html
Best regards,
Christian
> just following the chain . this seems a little simpler
> [...]
>
> set example {<h1>The Example</h1>
> <h2><u>The Rain</u></h2>
It seems you are trying to reinvent tkwebview, which is a basic HTML
> set example {<h1>The Example</h1>
> <h2><u>The Rain</u></h2>
parser for the text widget. I use it in a few programs to show rich text
in an easy way.
Kevin Walzer seems to have pulled it from the web, unfortunately, but
the wayback machine still has it:
https://web.archive.org/web/20100129063119/http://www.codebykevin.com/opensource/xplat_oss.html
Best regards,
Christian
Conor Williams
Oct 11, 2021, 5:37:56 PM10/11/21
to
it is zero bytes when i try to download it Christian... (the tkwebview program??)
Christian Gollwitzer
Oct 12, 2021, 1:40:04 AM10/12/21
to
Am 11.10.21 um 23:37 schrieb Conor Williams:
https://web.archive.org/web/20100129063119/http://www.codebykevin.com/opensource/tkwebview.zip
(833 kb)
Make sure to copy the whole link (with the "nested" http:// )
Christian
> it is zero bytes when i try to download it Christian... (the tkwebview program??)
>
This link works for me:
>
https://web.archive.org/web/20100129063119/http://www.codebykevin.com/opensource/tkwebview.zip
(833 kb)
Make sure to copy the whole link (with the "nested" http:// )
Christian
0 new messages