How to scan all label components within a toplevel or frame and set the option on the bind "<Enter>, <Leave> and <1>".
See illustrative example:
#!/bin/ash
# \
exec wish "$0" "$@"
package require Tk
wm withdraw .
toplevel .t -bg whitesmoke
wm geometry .t 240x180 0 0
###
######################## Begin Nav -> Menu -> Links ########################
label .t.l0 -bg whitesmoke -fg blue -cursor hand1 -text {Home}
label .t.l1 -bg whitesmoke -fg blue -cursor hand1 -text {Product}
label .t.l2 -bg whitesmoke -fg blue -cursor hand1 -text {Contact}
label .t.l3 -bg whitesmoke -fg blue -cursor hand1 -text {About}
pack .t.l0 .t.l1 .t.l2 .t.l3 -side top -anchor nw
########################## End Nav -> Menu -> Links #########################
###
###
##### Open and Read Script File for "count/quantify labels" within File #####
set fp [open "~/example.tk" r]
set n 0
set qtd {}
while {[gets $fp line] > 0} {
if [regexp -- label $line] {
lappend qtd $line
}
incr n
}
set total [llength $qtd]
close $fp
####################### Ready! Total of Labels counted #######################
###
###
##### Scan labels exists within toplevel or frame and create bind numered ####
for {set i 0} {$i < [expr $total - 1]} {incr i} {
set lbl .t.l$i
}
bind $lbl <Enter> {
$lbl config -font {-family courier -size 9 -underline true}
}
bind $lbl <Leave> {
$lbl config -font {-family courier -size 9 -underline false}
}
bind $lbl <1> {
tk_messageBox -message "You choice: [$lbl cget -text]"
}
####################### End Scan of labels, and end block ####################
###
What I intend with this is to do something in the menu style of links used in web sites and blogs.
I've made countless unsuccessful attempts, so far I haven't been able to.
Can someone enlighten me how I can do it.
CodePudding user response：
Well, I managed to solve the same day I posted the question but, I waited to see if anyone else had any or vision of how to solve the problem giving here an answer, I waited to pass the Christmas party period 2022 for only now i came up with the answer.
After thinking a lot, and analyzing what could be done in relation to numbering the events of the binds, I was able to find a solution that is the one that I will show in the source code is well commented, identified and separated into blocks. So this clear and objective, being thus easy to read on the part of other developers / programmers. Follows:
#!/bin/ash
# \
exec wish "$0" "$@"
package require Tk
wm withdraw .
toplevel .t -bg whitesmoke
wm geometry .t 240x180 0 0
###
######################## Begin Nav -> Menu -> Links ########################
label .t.l0 -bg whitesmoke -fg blue -cursor hand1 -text {Home}
label .t.l1 -bg whitesmoke -fg blue -cursor hand1 -text {Product}
label .t.l2 -bg whitesmoke -fg blue -cursor hand1 -text {Contact}
label .t.l3 -bg whitesmoke -fg blue -cursor hand1 -text {About}
pack .t.l0 .t.l1 .t.l2 .t.l3 -side top -anchor nw
######################### End Nav -> Menu -> Links #########################
###
###
########### Open and Read Script File for "count/quantify labels" within File ##########
set fp [open "~/example.tk" r]
set n 0
set qtd {}
while {[gets $fp line] > 0} {
if [regexp -- label $line] {
lappend qtd $line
}
incr n
}
set total [expr [llength $qtd] * 4]
close $fp
####################### Ready! Total of Labels counted #######################
####
###
######### Scan labels exists within toplevel or frame and create bind numered ########
set link {}
for {set i 0} {$i < [llength $qtd]} {incr i} {
set lbl ".t.l$i"
# on mouse over
lappend link "bind $lbl <Enter> { $lbl config -font {-family courier -size 9 -underline true} }"
# on mouse out
lappend link "bind $lbl <Leave> { $lbl config -font {-family courier -size 9 -underline false} }"
# on click
lappend link "@bind $lbl <Button-1> { bell ; clic $lbl }@"
# used only whitespace line
lappend link "#"
}
set fw [open "/tmp/bind-tags-events.src" w]
for {set n 0} {$n < $total} {incr n} {
set cnt [lindex [split $link] $n]
set lst [string map { " " " " "{@" "" "@}" "" "#" "" } $cnt]
puts $fw "$lst"
}
close $fw
##################### End Scan of labels, and end block ######################
###
###
############################ Source BindTags ############################
source /tmp/bind-tags-events.src
after 100 {
file delete /tmp/bind-tags-events.src
}
########################### End Source BindTags ##########################
###
Note that, I'm doing here is, 'for-loop' create the necessary binds for the events already numbered for each 'label' having as output to an external file named as bind-tags-events.src in the temporary directory -, /tmp (GNU/Linux operating systems), and I am incorporating the same file via 'source' and finally 'delete' it after being integrated into the 'script'
Note
The multiplier number is given by the number of
binds inside thefor-loop, in our case we have 4, so we use the arithmetic expression[expr [llength $dir] * 4]. If you increase or decrease the number ofbindyou put in to give effect to thelabelthen this number must be different from 4.
Alert
If you was use this logic with some glob, so that way:
We have to create two separate bind-tags-link.src files. One for "Directories" and one for "Files". So it looks like this:
#!/bin/ash
# \
exec wish "$0" "$@"
... Code here
###
##################### Begin: 1nd block - Folders ###################
set linkFolder {}
proc listFolder {} {
# list only directories
set dir [cd $env(HOME)]
set dir [glob -nocomplain -directory $dir -type d -tails *.*]
set total [expr [llength $dir] * 4]
for {set i 0} {$i < $total} {incr i} {
set lbl ".t.l$i"
# on mouse over
lappend linkFolder "bind $lbl <Enter> { $lbl config -font {-family courier -size 9 -underline true} }"
# on mouse out
lappend linkFolde "bind $lbl <Leave> { $lbl config -font {-family courier -size 9 -underline false} }"
# on click
lappend linkFolder "@bind $lbl <Button-1> { bell ; clic $lbl }@"
# used only whitespace line
lappend linkFolder "#"
}
}
listFoder
######################### End: 1nd block #########################
###
###
##################### Begin: 2nd block - Files ###################
set linkFile {}
proc listFile {} {
# list only files
set fl [cd $env(HOME)]
set fl [glob -nocomplain -directory $fl -type f -tails *.*]
set total [expr [llength $fl] * 4]
for {set i 0} {$i < $total} {incr i} {
set lbl ".t.l$i"
# on mouse over
lappend linkFile "bind $lbl <Enter> { $lbl config -font {-family courier -size 9 -underline true} }"
# on mouse out
lappend linkFile "bind $lbl <Leave> { $lbl config -font {-family courier -size 9 -underline false} }"
# on click
lappend linkFile "@bind $lbl <Button-1> { bell ; clic $lbl }@"
# used only whitespace line
lappend linkFile "#"
}
}
listFile
######################### End: 2nd block #########################
###
###
######################### Begin: 3nd block - Embed #########################
source /tmp/bind-folder-links.src
source /tmp/bind-file-links.src
after 100 {
foreach clear {bind-folder-links.src bind-file-links.src} {
file delete /tmp/$clear
}
}
############################# End: 3nd block ############################
###
For some, it may seem unnecessary to leave this message here, but I think it is very helpful for those who don't want to waste time trying to adapt it in case someone prefers to make such a list.