Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | * scripts/mwutil.tcl: Updated to the same version 2.15 as in Tablelist release 6.7. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
60cdfbf809264ea36ebbaf5e8294018e |
| User & Date: | csaba 2019-10-21 13:27:50 |
Context
|
2019-10-21
| ||
| 13:28 | * scripts/tclIndex: Newly generated. check-in: 18473137e7 user: csaba tags: trunk | |
| 13:27 | * scripts/mwutil.tcl: Updated to the same version 2.15 as in Tablelist release 6.7. check-in: 60cdfbf809 user: csaba tags: trunk | |
| 13:27 | * CHANGES.txt: Updated to reflect the changes. check-in: 1e9bbb52f6 user: csaba tags: trunk | |
Changes
Changes to modules/mentry/scripts/mwutil.tcl.
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 .. 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 ... 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 ... 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 ... 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 |
# ========================
#
namespace eval mwutil {
#
# Public variables:
#
variable version 2.12
variable library
if {$::tcl_version >= 8.4} {
set library [file dirname [file normalize [info script]]]
} else {
set library [file dirname [info script]] ;# no "file normalize" yet
}
................................................................................
#
# Public procedures:
#
namespace export wrongNumArgs getAncestorByClass convEventFields \
defineKeyNav processTraversal focusNext focusPrev \
configureWidget fullConfigOpt fullOpt enumOpts \
configureSubCmd attribSubCmd hasattribSubCmd \
unsetattribSubCmd getScrollInfo hasFocus \
genMouseWheelEvent windowingSystem currentTheme
#
# Make modified versions of the procedures tk_focusNext and
# tk_focusPrev, to be invoked in the processTraversal command
#
proc makeFocusProcs {} {
#
................................................................................
optValPairs initialize} {
upvar $configSpecsName configSpecs
#
# Process the command-line arguments
#
set cmdLineOpts {}
set savedVals {}
set failed 0
set count [llength $optValPairs]
foreach {opt val} $optValPairs {
if {[catch {fullConfigOpt $opt configSpecs} result] != 0} {
set failed 1
break
}
................................................................................
if {$count == 1} {
set result "value for \"$opt\" missing"
set failed 1
break
}
set opt $result
lappend cmdLineOpts $opt
lappend savedVals [eval $cgetCmd [list $win $opt]]
if {[catch {eval $configCmd [list $win $opt $val]} result] != 0} {
set failed 1
break
}
incr count -2
}
if {$failed} {
#
# Restore the saved values
#
foreach opt $cmdLineOpts val $savedVals {
eval $configCmd [list $win $opt $val]
}
return -code error $result
}
if {$initialize} {
................................................................................
} else {
return -code error "bad argument \"$what\": must be units or pages"
}
} else {
return -code error "unknown option \"$opt\": must be moveto or scroll"
}
}
#------------------------------------------------------------------------------
# mwutil::hasFocus
#
# Returns a boolean value indicating whether the focus window is (a descendant
# of) the widget w.
#------------------------------------------------------------------------------
proc mwutil::hasFocus w {
return [expr {[string first $w. [focus -displayof $w].] == 0}]
}
#------------------------------------------------------------------------------
# mwutil::genMouseWheelEvent
#
# Generates a mouse wheel event with the given root coordinates and delta on
# the widget w.
|
| | > | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > |
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 .. 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 ... 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 ... 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 ... 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 |
# ========================
#
namespace eval mwutil {
#
# Public variables:
#
variable version 2.15
variable library
if {$::tcl_version >= 8.4} {
set library [file dirname [file normalize [info script]]]
} else {
set library [file dirname [info script]] ;# no "file normalize" yet
}
................................................................................
#
# Public procedures:
#
namespace export wrongNumArgs getAncestorByClass convEventFields \
defineKeyNav processTraversal focusNext focusPrev \
configureWidget fullConfigOpt fullOpt enumOpts \
configureSubCmd attribSubCmd hasattribSubCmd \
unsetattribSubCmd getScrollInfo getScrollInfo2 \
isScrollable hasFocus genMouseWheelEvent \
windowingSystem currentTheme
#
# Make modified versions of the procedures tk_focusNext and
# tk_focusPrev, to be invoked in the processTraversal command
#
proc makeFocusProcs {} {
#
................................................................................
optValPairs initialize} {
upvar $configSpecsName configSpecs
#
# Process the command-line arguments
#
set cmdLineOpts {}
set savedOptValPairs {}
set failed 0
set count [llength $optValPairs]
foreach {opt val} $optValPairs {
if {[catch {fullConfigOpt $opt configSpecs} result] != 0} {
set failed 1
break
}
................................................................................
if {$count == 1} {
set result "value for \"$opt\" missing"
set failed 1
break
}
set opt $result
lappend cmdLineOpts $opt
lappend savedOptValPairs $opt [eval $cgetCmd [list $win $opt]]
if {[catch {eval $configCmd [list $win $opt $val]} result] != 0} {
set failed 1
break
}
incr count -2
}
if {$failed} {
#
# Restore the saved values
#
foreach {opt val} $savedOptValPairs {
eval $configCmd [list $win $opt $val]
}
return -code error $result
}
if {$initialize} {
................................................................................
} else {
return -code error "bad argument \"$what\": must be units or pages"
}
} else {
return -code error "unknown option \"$opt\": must be moveto or scroll"
}
}
#------------------------------------------------------------------------------
# mwutil::getScrollInfo2
#
# Parses a list of arguments of the form "moveto <fraction>" or "scroll
# <number> units|pages" and returns the corresponding list consisting of two or
# three properly formatted elements.
#------------------------------------------------------------------------------
proc mwutil::getScrollInfo2 {cmd argList} {
set argCount [llength $argList]
set opt [lindex $argList 0]
if {[string first $opt "moveto"] == 0} {
if {$argCount != 2} {
wrongNumArgs "$cmd moveto fraction"
}
set fraction [lindex $argList 1]
format "%f" $fraction ;# floating-point number check with error message
return [list moveto $fraction]
} elseif {[string first $opt "scroll"] == 0} {
if {$argCount != 3} {
wrongNumArgs "$cmd scroll number units|pages"
}
set number [format "%d" [lindex $argList 1]]
set what [lindex $argList 2]
if {[string first $what "units"] == 0} {
return [list scroll $number units]
} elseif {[string first $what "pages"] == 0} {
return [list scroll $number pages]
} else {
return -code error "bad argument \"$what\": must be units or pages"
}
} else {
return -code error "unknown option \"$opt\": must be moveto or scroll"
}
}
#------------------------------------------------------------------------------
# mwutil::isScrollable
#
# Returns a boolean value indicating whether the widget w is scrollable along a
# given axis (x or y).
#------------------------------------------------------------------------------
proc mwutil::isScrollable {w axis} {
set viewCmd ${axis}view
return [expr {
[catch {$w cget -${axis}scrollcommand}] == 0 &&
[catch {$w $viewCmd} view] == 0 &&
[catch {$w $viewCmd moveto [lindex $view 0]}] == 0 &&
[catch {$w $viewCmd scroll 0 units}] == 0 &&
[catch {$w $viewCmd scroll 0 pages}] == 0
}]
}
#------------------------------------------------------------------------------
# mwutil::hasFocus
#
# Returns a boolean value indicating whether the focus window is (a descendant
# of) the widget w and has the same toplevel.
#------------------------------------------------------------------------------
proc mwutil::hasFocus w {
set focusWin [focus -displayof $w]
return [expr {
[string first $w. $focusWin.] == 0 &&
[string compare [winfo toplevel $w] [winfo toplevel $focusWin]] == 0
}]
}
#------------------------------------------------------------------------------
# mwutil::genMouseWheelEvent
#
# Generates a mouse wheel event with the given root coordinates and delta on
# the widget w.
|