Tk Library Source Code

#! /usr/bin/env tclsh

#==============================================================================
# Demonstrates the interactive tablelist cell editing with the aid of Ttk
# widgets and the configuration of boolean editing options using toggleswitch
# widgets.
#
# Copyright (c) 2005-2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

package require Tk
package require tsw
package require tablelist_tile

wm title . "Serial Line Configuration"

#
# Add some entries to the Tk option database
#
set dir [file dirname [info script]]
source [file join $dir option_tile.tcl]

foreach theme {alt clam classic default} {
    #
    # Configure the TSpinbox style
    #
    ttk::style theme settings $theme {
	ttk::style map TSpinbox -fieldbackground {readonly white}
    }
}
unset theme

#
# Create the images "checkedImg" and "uncheckedImg", as well as 16 images of
# names like "img#FF0000", displaying colors identified by names like "red"
#
source [file join $dir images.tcl]

#
# Improve the window's appearance by using a tile
# frame as a container for the other widgets
#
set f [ttk::frame .f]

#
# Create a tablelist widget with editable columns (except the first one)
#
set tbl $f.tbl
tablelist::tablelist $tbl \
    -columns {0 "No."		right
	      0 "Available"	center
	      0 "Name"		left
	      0 "Baud Rate"	right
	      0 "Data Bits"	center
	      0 "Parity"	left
	      0 "Stop Bits"	center
	      0 "Handshake"	left
	      0 "Cable Color"	center} \
    -editstartcommand editStartCmd -editendcommand editEndCmd \
    -aftercopycommand afterCopyCmd -height 0 -width 0
set isAwTheme \
    [llength [info commands ::ttk::theme::${currentTheme}::setTextColors]]
if {$isAwTheme && ![regexp {^(aw)?(arc|breeze.*)$} $currentTheme]} {
    $tbl configure -borderwidth 2
}
if {[$tbl cget -selectborderwidth] == 0} {
    $tbl configure -spacing 1
}
$tbl columnconfigure 0 -sortmode integer
$tbl columnconfigure 1 -name available -editable yes \
    -editwindow ttk::checkbutton -formatcommand emptyStr \
    -labelwindow ttk::checkbutton
$tbl columnconfigure 2 -name lineName  -editable yes -editwindow ttk::entry \
    -allowduplicates 0 -sortmode dictionary
$tbl columnconfigure 3 -name baudRate  -editable yes -editwindow ttk::combobox \
    -sortmode integer
$tbl columnconfigure 4 -name dataBits  -editable yes -editwindow ttk::spinbox
$tbl columnconfigure 5 -name parity    -editable yes -editwindow ttk::combobox
$tbl columnconfigure 6 -name stopBits  -editable yes -editwindow ttk::combobox
$tbl columnconfigure 7 -name handshake -editable yes -editwindow ttk::combobox
$tbl columnconfigure 8 -name color     -editable yes \
    -editwindow ttk::menubutton -formatcommand emptyStr

proc emptyStr val { return "" }

#
# Populate the tablelist widget and configure the checkbutton
# embedded into the header label of the column "available"
#
source [file join $dir serialParams.tcl]

set bf [ttk::frame $f.bf]
set b1 [ttk::button $bf.b1 -text "Configure Editing" \
	-command [list configEditing $tbl]]
set b2 [ttk::button $bf.b2 -text "Close" -command exit]

#
# Manage the widgets
#
pack $b2 -side right -padx 9p
pack $b1 -side left -padx 9p
pack $bf -side bottom -fill x -pady 9p
pack $tbl -side top -expand yes -fill both -padx 9p -pady {9p 0}
pack $f -expand yes -fill both

#------------------------------------------------------------------------------
# editStartCmd
#
# Applies some configuration options to the edit window; if the latter is a
# combobox, the procedure populates it.
#------------------------------------------------------------------------------
proc editStartCmd {tbl row col text} {
    set w [$tbl editwinpath]

    switch [$tbl columncget $col -name] {
	lineName {
	    #
	    # Set an upper limit of 20 for the number of characters
	    #
	    $w configure -invalidcommand bell -validate key \
			 -validatecommand {expr {[string length %P] <= 20}}
	}

	baudRate {
	    #
	    # Populate the combobox and allow no more
	    # than 6 digits in its entry component
	    #
	    $w configure -values {50 75 110 300 1200 2400 4800 9600 19200 38400
				  57600 115200 230400 460800 921600}
	    $w configure -invalidcommand bell -validate key -validatecommand \
		{expr {[string length %P] <= 6 && [regexp {^[0-9]*$} %S]}}
	}

	dataBits {
	    #
	    # Configure the spinbox
	    #
	    $w configure -from 5 -to 8 -state readonly
	}

	parity {
	    #
	    # Populate the combobox and make it non-editable
	    #
	    $w configure -values {None Even Odd Mark Space} -state readonly
	}

	stopBits {
	    #
	    # Populate the combobox and make it non-editable
	    #
	    $w configure -values {1 1.5 2} -state readonly
	}

	handshake {
	    #
	    # Populate the combobox and make it non-editable
	    #
	    $w configure -values {XON/XOFF RTS/CTS None} -state readonly
	}

	color {
	    #
	    # Populate the menu and make sure the menubutton will display the
	    # color name rather than $text, which is "", due to -formatcommand
	    #
	    set menu [$w cget -menu]
	    foreach name $::colorNames {
		$menu add radiobutton -compound left \
		    -image img$::colors($name) -label $name
	    }
	    $menu entryconfigure 8 -columnbreak 1
	    return [$tbl cellcget $row,$col -text]
	}
    }

    return $text
}

#------------------------------------------------------------------------------
# editEndCmd
#
# Performs a final validation of the text contained in the edit window and gets
# the cell's internal content.
#------------------------------------------------------------------------------
proc editEndCmd {tbl row col text} {
    switch [$tbl columncget $col -name] {
	available {
	    #
	    # Update the image contained in the cell and the checkbutton
	    # embedded into the header label of the column "available"
	    #
	    set img [expr {$text ? "checkedImg" : "uncheckedImg"}]
	    $tbl cellconfigure $row,$col -image $img
	    after idle [list updateCkbtn $tbl $row $col]
	}

	baudRate {
	    #
	    # Check whether the baud rate is an integer in the range 50..921600
	    #
	    if {![regexp {^[0-9]+$} $text] || $text < 50 || $text > 921600} {
		bell
		tk_messageBox -title "Error" -icon error -message \
		    "The baud rate must be an integer in the range 50..921600"
		$tbl rejectinput
	    }
	}

	color {
	    #
	    # Update the image contained in the cell
	    #
	    $tbl cellconfigure $row,$col -image img$::colors($text)
	}
    }

    return $text
}

#------------------------------------------------------------------------------
# configEditing
#
# Configures the editing-related tablelist options having boolean values with
# the aid of toggleswitch widgets.
#------------------------------------------------------------------------------
proc configEditing tbl {
    set top .top
    if {[winfo exists $top]} {
	raise $top
	focus $top
	return ""
    }

    toplevel $top
    wm title $top "Editing Options"

    set tf [ttk::frame $top.tf]
    set bf [ttk::frame $top.bf]

    #
    # Create the widgets corresponding to the
    # editing-related options with boolean values
    #
    set row 0
    foreach opt {
	-autofinishediting
	-editendonfocusout
	-editendonmodclick
	-editselectedonly
	-forceeditendcommand
	-instanttoggle
	-showeditcursor
    } {
	lassign [$tbl configure $opt] option dbName dbClass default current
	set defaultStr [expr {$default ? "on" : "off"}]

	set l [ttk::label $tf.l$row -text "$opt ($defaultStr)"]
	if {$current != $default} {
	    $l configure -foreground red3
	}
	grid $l -row $row -column 0 -sticky w -padx 9p -pady {0 3p}

	set sw [tsw::toggleswitch $tf.sw$row]
	$sw switchstate $current	;# sets the switch state to $current
	$sw attrib default $default	;# saves $default as attribute value
	$sw configure -command [list applySwitchState $sw $l $tbl $opt]
	grid $sw -row $row -column 1 -sticky w -padx {0 9p} -pady {0 3p}

	incr row
    }

    grid configure $tf.l0 $tf.sw0 -pady {9p 3p}
    grid columnconfigure $tf 0 -weight 1

    #   
    # Create a ttk::button widget
    #
    set b [ttk::button $bf.b -text "Close" -command [list destroy $top]]
    pack $b -pady {6p 9p}

    pack $bf -side bottom -fill x
    pack $tf -expand yes -fill both
}

#------------------------------------------------------------------------------
# applySwitchState
#
# Sets the configuration option opt of the tablelist tbl and the foreground
# color of the ttk::label l according to the switch state of the toggleswitch
# widget sw.
#------------------------------------------------------------------------------
proc applySwitchState {sw l tbl opt} {
    set switchState [$sw switchstate]
    $tbl configure $opt $switchState

    set fgColor [expr {$switchState == [$sw attrib default] ? "" : "red3"}]
    $l configure -foreground $fgColor
}

#! /usr/bin/env tclsh

#==============================================================================
# Demonstrates the use of the toggleswitch widget.
#
# Copyright (c) 2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

package require Tk
package require tsw

wm title . "Tsw Demo"

ttk::frame .tf
ttk::frame .bf

#
# Create 3 toggleswitch widgets having different values of the -size option
#
set l1 [ttk::label .tf.l1 -text "Toggle switch of size 1"]
set sw1 [tsw::toggleswitch .tf.sw1 -size 1]
set l2 [ttk::label .tf.l2 -text "Toggle switch of size 2"]
set sw2 [tsw::toggleswitch .tf.sw2 -size 2]
$sw2 switchstate 1
set l3 [ttk::label .tf.l3 -text "Toggle switch of size 3"]
set sw3 [tsw::toggleswitch .tf.sw3 -size 3]

#
# Create a toggleswitch widget of default size and set its -command option
#
set l4 [ttk::label .tf.l4 -text "Enable/disable above widgets"]
set sw4 [tsw::toggleswitch .tf.sw4]
$sw4 switchstate 1
$sw4 configure -command [list toggleWidgetsState $sw4]

#
# Create a ttk::menubutton used to select the theme
#
set mb .bf.mb
ttk::menubutton $mb -menu $mb.m
menu $mb.m -tearoff 0
### set themeList [ttk::style theme names]	;# built-in themes only
set themeList [ttk::themes]			;# third-party themes, too
foreach theme [lsort -dictionary $themeList] {
    $mb.m add command -label $theme -command [list setTheme $theme]
}

#
# Create a ttk::button widget
#
set b [ttk::button .bf.b -text "Close" -command exit]

#------------------------------------------------------------------------------
# toggleWidgetsState
#
# Enables/disables the widgets in the first 3 grid rows, depending on the
# switch state of the specified toggleswitch widget.
#------------------------------------------------------------------------------
proc toggleWidgetsState sw {
    global l1 l2 l3 sw1 sw2 sw3
    set stateSpec [expr {[$sw switchstate] ? "!disabled" : "disabled"}]
    foreach w [list $l1 $l2 $l3 $sw1 $sw2 $sw3] {
	$w state $stateSpec
    }
}

#------------------------------------------------------------------------------
# setTheme
#
# Sets the theme to the specified one and configures the ttk::menubutton and
# its menu accordingly.
#------------------------------------------------------------------------------
proc setTheme theme {
    ttk::setTheme $theme
    global mb l1 l2 l3 l4
    $mb configure -text $theme

    set bg [ttk::style lookup . -background]
    set fg [ttk::style lookup . -foreground]
    $mb.m configure -background $bg -foreground $fg

    foreach opt {-activebackground -activeborderwidth -activeforeground
		 -borderwidth -relief -selectcolor} {
	set defaultVal [lindex [$mb.m configure $opt] 3]
	$mb.m configure $opt $defaultVal
    }

    foreach w [list $l1 $l2 $l3 $l4] {
	$w configure -background "" -foreground ""
    }
}

set origTheme [expr {$argc == 0 ? [ttk::style theme use] : [lindex $argv 0]}]
setTheme $origTheme

#------------------------------------------------------------------------------

#
# Manage the children of .tf
#
grid $l1 $sw1 -pady {9p 0} -sticky w
grid $l2 $sw2 -sticky w
grid $l3 $sw3 -sticky w
grid $l4 $sw4 -pady 6p -sticky w
grid configure $l1 $l2 $l3 $l4 -padx {9p 6p}
grid configure $sw1 $sw2 $sw3 $sw4 -padx {0 9p}
grid columnconfigure .tf 0 -weight 1

#
# Manage the children of .bf
#
grid $mb $b -padx 9p -pady {0 9p} -sticky w
grid configure $b -padx {0 9p}
grid columnconfigure .bf 0 -weight 1

pack .bf -side bottom -fill x
pack .tf -expand yes -fill both

#==============================================================================
# Creates some images.
#
# Copyright (c) 2011-2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

#
# Create two images, to be displayed in tablelist cells with boolean values
#
set fmt $tablelist::svgfmt
image create photo checkedImg -format $fmt -data {
<svg width="12" height="12" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x=".5" y=".5" width="11" height="11" rx="1.5" fill="#fff" stroke="#808080"/>
 <path d="m3 6 2.5 2.5 3.5-5" fill="none" stroke="#000" stroke-linecap="round" stroke-linejoin="round"/>
</svg>}
image create photo uncheckedImg -format $fmt -data {
<svg width="12" height="12" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x=".5" y=".5" width="11" height="11" rx="1.5" fill="#fff" stroke="#808080"/>
</svg>}

#
# Create 16 images representing different colors
#
set colorNames {
    "red" "green" "blue" "magenta"
    "yellow" "cyan" "light gray" "white"
    "dark red" "dark green" "dark blue" "dark magenta"
    "dark yellow" "dark cyan" "dark gray" "black"
}
set colorValues {
    #FF0000 #00FF00 #0000FF #FF00FF
    #FFFF00 #00FFFF #C0C0C0 #FFFFFF
    #800000 #008000 #000080 #800080
    #808000 #008080 #808080 #000000
}
foreach name $colorNames value $colorValues {
    set colors($name) $value
}
set dim  [expr {round(12 * $scaleutil::scalingPct / 100.0)}]
set dim1 [expr {$dim - 1}]
foreach value $colorValues {
    image create photo img$value -height $dim -width $dim
    img$value put gray50 -to 0 0 $dim 1				;# top edge
    img$value put gray50 -to 0 1 1 $dim1			;# left edge
    img$value put gray75 -to 0 $dim1 $dim $dim			;# bottom edge
    img$value put gray75 -to $dim1 1 $dim $dim1			;# right edge
    img$value put $value -to 1 1 $dim1 $dim1			;# interior
}

#==============================================================================
# Contains some Tk option database settings.
#
# Copyright (c) 2004-2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

#
# Add some entries to the Tk option database
#
set currentTheme [tablelist::getCurrentTheme]
if {$tablelist::themeDefaults(-stripebackground) eq "" &&
    $currentTheme ne "black" && $currentTheme ne "breeze-dark" &&
    $currentTheme ne "sun-valley-dark"} {
    option add *Tablelist.background		white
    option add *Tablelist.stripeBackground	#f0f0f0
}
if {[tk windowingsystem] eq "x11"} {
    option add *Font		  TkDefaultFont
    option add *selectBackground  $tablelist::themeDefaults(-selectbackground)
    option add *selectForeground  $tablelist::themeDefaults(-selectforeground)
}
option add *selectBorderWidth	  $tablelist::themeDefaults(-selectborderwidth)
option add *Tablelist.movableColumns		yes
option add *Tablelist.labelCommand		tablelist::sortByColumn
option add *Tablelist.labelCommand2		tablelist::addToSortColumns

#==============================================================================
# Populates a tablelist widget with the parameters of 16 serial lines,
# configures the checkbutton embedded into the header label of the column
# "available", and implements the procedures updateCkbtn and afterCopyCmd.
#
# Copyright (c) 2021-2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

#
# Populate the tablelist widget
#
for {set row 0; set line 1} {$row < 16} {set row $line; incr line} {
    $tbl insert end [list $line [expr {$row < 8}] "Line $line" 9600 8 None 1 \
		     XON/XOFF [lindex $colorNames $row]]

    set availImg [expr {($row < 8) ? "checkedImg" : "uncheckedImg"}]
    $tbl cellconfigure $row,available -image $availImg
    $tbl cellconfigure $row,color -image img[lindex $colorValues $row]
}

#
# Configure the "-command" option of the checkbutton embedded into the
# header label of the column "available", and make sure that it will be
# reconfigured whenever any column is moved interactively to a new position
#
proc configCkbtn {tbl col} {
    set ckbtn [$tbl labelwindowpath $col]
    $ckbtn configure -command [list onCkbtnToggle $tbl $col $ckbtn]
}
proc onCkbtnToggle {tbl col ckbtn} {
    upvar #0 [$ckbtn cget -variable] var
    $tbl fillcolumn $col -text $var
    $tbl fillcolumn $col -image [expr {$var ? "checkedImg" : "uncheckedImg"}]
}
configCkbtn $tbl available
bind $tbl <<TablelistColumnMoved>> { configCkbtn %W available }
bind $tbl <<ThemeChanged>>	   { configCkbtn %W available }

#
# Make sure that the checkbutton will appear in tri-state mode
#
set ckbtn [$tbl labelwindowpath available]
set varName [$ckbtn cget -variable]
unset $varName

#
# Selects/deselects the checkbutton embedded into the header label
# of the specified column or sets it into the tri-state mode.
#
proc updateCkbtn {tbl row col} {
    set lst [$tbl getcolumns $col]
    set ckbtn [$tbl labelwindowpath $col]
    upvar #0 [$ckbtn cget -variable] var

    if {[lsearch -exact $lst 1] < 0} {			;# all 0
	set var 0					;# deselect
    } elseif {[lsearch -exact $lst 0] < 0} {		;# all 1
	set var 1					;# select
    } else {
	unset -nocomplain var				;# tri-state mode
    }
}

#
# For the columns "available" and "color", updates
# the images contained in the column's cells.
#
proc afterCopyCmd {tbl col} {
    switch [$tbl columncget $col -name] {
	available {
	    #
	    # Update the images contained in the column's cells and
	    # the checkbutton embedded into the column's header label
	    #
	    for {set row 0} {$row < 16} {incr row} {
		set text [$tbl cellcget $row,$col -text]
		set img [expr {$text ? "checkedImg" : "uncheckedImg"}]
		$tbl cellconfigure $row,$col -image $img
	    }
	    updateCkbtn $tbl 0 $col
	}

	color {
	    #
	    # Update the images contained in the column's cells
	    #
	    for {set row 0} {$row < 16} {incr row} {
		set text [$tbl cellcget $row,$col -text]
		$tbl cellconfigure $row,$col -image img$::colors($text)
	    }
	}
    }
}

What is new in Tsw 1.0?
-----------------------

This is the first release.

Toggle switch widget package Tsw 1.0
Copyright (c) 2025  Csaba Nemethi (E-mail: [email protected])

This library is free software; you can use, modify, and redistribute it
for any purpose, provided that existing copyright notices are retained
in all copies and that this notice is included verbatim in any
distributions.

This software is distributed WITHOUT ANY WARRANTY; without even the
implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

2025-03-10  Csaba Nemethi <[email protected]>

	* Added tsw to tklib.

		  The Toggle Switch Widget Package Tsw

                                   by

                             Csaba Nemethi

                       [email protected] 


What Is Tsw?
------------

Tsw is a library package for Tcl/Tk versions 8.6 or higher.  If the
version is 8.6 then in addition it is required that the tksvg extension
can be loaded into the interpreter (Tk versions 8.7 and 9.0 or higher
have built-in SVG support).  The package is written in pure Tcl/Tk code
and contains:

  - the implementation of the "toggleswitch" mega-widget, including a
    general utility module for mega-widgets;
  - two richly commented demo scripts containing the typical steps
    needed to create and handle toggleswitch widgets;
  - a tutorial in HTML format;
  - a reference page in HTML format.

A toggleswitch is a mega-widget consisting of a horizontal trough (a
fully rounded filled rectangle) and a slider (a filled circle contained
in the trunk).  It can have one of two possible switch states: on or
off.  In the on state the slider is placed at the end of the trough, and
in the off state at its beginning.  The user can toggle between these
two states with the mouse or the space key.

You can use the "switchstate" subcommand of the Tcl command associated
with a toggleswitch to change or query the widget's switch state.  By
using the "-command" configuration option, you can specify a script to
execute whenever the switch state of the widget gets toggled.

How to Get It?
--------------

Tsw is available for free download from the Web page

    https://www.nemethi.de

The distribution file is "tsw1.0.tar.gz" for UNIX and "tsw1_0.zip" for
Windows.  These files contain the same information, except for the
additional carriage return character preceding the linefeed at the end
of each line in the text files for Windows.

Tsw is also included in tklib, which has the address

    https://core.tcl.tk/tklib

How to Install It?
------------------

Install the package as a subdirectory of one of the directories given
by the "auto_path" variable.  For example, you can install it as a
subdirectory of the "lib" directory within your Tcl/Tk installation (at
the same level as the tk8.7 or tk9.0 subdirectory).

To install Tsw on UNIX, "cd" to the desired directory and unpack the
distribution file "tsw1.0.tar.gz":

    gunzip -c tsw1.0.tar.gz | tar -xf -

On most UNIX systems this can be replaced with

    tar -zxf tsw1.0.tar.gz

Both commands will create a directory named "tsw1.0", with the
subdirectories "demos", "doc", and "scripts".

On Windows, use WinZip or some other program capable of unpacking the
distribution file "tsw1_0.zip" into the directory "tsw1.0", with the
subdirectories "demos", "doc", and "scripts".

How to Use It?
--------------

To be able to use the commands and variables defined in the Tsw
package, your scripts must contain one of the lines

    package require tsw ?version?
    package require Tsw ?version?

Since the Tsw package is implemented in its own namespace called "tsw",
you must either invoke the

    namespace import tsw::toggleswitch

command to import the only public procedure of the tsw namespace, or use
the qualified name tsw::toggleswitch.  To access Tsw variables, you must
use qualified names.

For a detailed description of the commands and variables provided by Tsw
and of the examples contained in the "demos" directory, see the tutorial
"tsw.html" and the reference page "toggleswitch.html", both located in
the "doc" directory.

<!DOCTYPE html>
<html>
<head>
  <title>The Toggle Switch Widget Package Tsw 1.0</title>

  <meta name="Author" content="Csaba Nemethi">
  <meta name="Keywords" content="toggleswitch, widget">

  <link rel="stylesheet" type="text/css" href="stylesheet.css">
</head>

<body>
  <div>
    <h1>The Toggle Switch Widget Package Tsw 1.0</h1>

    <h3>by</h3>

    <h2>Csaba Nemethi</h2>

    <address>
      <a href="mailto:[email protected]">[email protected]</a>
    </address>
  </div>

  <hr>

  <h2>Contents</h2>

  <p><a href="tsw.html">Tsw Programmer's Guide</a></p>

  <p><a href="toggleswitch.html">The <code>tsw::toggleswitch</code>
  Command</a></p>
</body>
</html>

/* generic class defining a top margin whose height equals the font size */
.tm {margin-top: 1em}

/* background, border, border-radius, and padding for the <pre> tag */
pre {
  background: #F7F7F7;
  border: silver solid 1px;
  border-radius: 4px;
  padding: 4px;
}

/* background for the <body> tag */
body {background: #FFFFFF}

/* text-align for the <div> tag */
div {text-align: center}

/* color for the <span> tag */
span.red {color: #E00000}
span.cmt {color: #36648b}

<!DOCTYPE html>
<html>
<head>
  <title>The tsw::toggleswitch Command</title>
  
  <meta name="Author" content="Csaba Nemethi">
  <meta name="Keywords" content="toggleswitch, widget">
    
  <link rel="stylesheet" type="text/css" href="stylesheet.css">
</head>
    
<body>
  <div>
    <h1>The <code><b>tsw::toggleswitch</b></code> Command</h1>

    <h2>For Tsw Version 1.0</h2>

    <h3>by</h3>
    
    <h2>Csaba Nemethi</h2>

    <address>
      <a href="mailto:[email protected]">[email protected]</a>
    </address>
  </div>

  <hr>
    
  <h2 id="contents">Contents</h2>

  <ul>
    <li><a href="#quick_ref">Quick Reference</a></li>
    
    <li><a href="#detailed_ref">Detailed Reference</a></li>
  </ul>

  <div>
    <p><a href="index.html">Start page</a></p>
  </div>

  <hr>

  <h2 id="quick_ref">Quick Reference</h2>

  <dl>
    <dt><a href="#name">NAME</a></dt>

    <dd><code>tsw::toggleswitch</code> &ndash; Create and manipulate toggle
    switch widgets</dd>

    <dt class="tm"><a href="#synopsis">SYNOPSIS</a></dt>

    <dd>
      <pre>
<b>tsw::toggleswitch</b> <i>pathName</i> ?<i>options</i>?
</pre>
    </dd>

    <dt><a href="#description">DESCRIPTION</a></dt>

    <dt class="tm"><a href="#std_options">STANDARD OPTIONS</a></dt>

    <dd>
      <pre>
<b>-cursor</b>
</pre>
    </dd>

    <dt><a href="#widget_options">WIDGET-SPECIFIC OPTIONS</a></dt>

    <dd><code><b><a href="#command">-command</a></b> <i>command</i></code></dd>

    <dd><code><b><a href="#size">-size</a></b>
    <b>1</b>|<b>2</b>|<b>3</b></code></dd>

    <dd><code><b><a href="#takefocus">-takefocus</a></b>
    <b>0</b>|<b>1</b>|<b>""</b>|<i>command</i></code></dd>

    <dt class="tm"><a href="#widget_command">WIDGET COMMAND</a></dt>

    <dd><code><i>pathName</i> <b><a href="#attrib">attrib</a></b> ?<i>name</i>
    ?<i>value</i> <i>name</i> <i>value</i> ...??</code></dd>

    <dd><code><i>pathName</i> <b><a href="#cget">cget</a></b>
    <i>option</i></code></dd>

    <dd><code><i>pathName</i> <b><a href="#configure">configure</a></b>
    ?<i>option</i> ?<i>value</i> <i>option</i> <i>value</i> ...??</code></dd>

    <dd><code><i>pathName</i> <b><a href="#hasattrib">hasattrib</a></b>
    <i>name</i></code></dd>

    <dd><code><i>pathName</i> <b><a href="#identify">identify</a></b>
    ?<b>element</b>? <i>x</i> <i>y</i></code></dd>

    <dd><code><i>pathName</i> <b><a href="#instate">instate</a></b>
    <i>stateSpec</i> ?<i>script</i>?</code></dd>

    <dd><code><i>pathName</i> <b><a href="#state">state</a></b>
    ?<i>stateSpec</i>?</code></dd>

    <dd><code><i>pathName</i> <b><a href="#style">style</a></b></code></dd>

    <dd><code><i>pathName</i> <b><a href="#switchstate">switchstate</a></b>
    ?<i>boolean</i>?</code></dd>

    <dd><code><i>pathName</i> <b><a href="#toggle">toggle</a></b></code></dd>

    <dd><code><i>pathName</i> <b><a href="#unsetattrib">unsetattrib</a></b>
    <i>name</i></code></dd>

    <dt class="tm"><a href="#bindings">DEFAULT BINDINGS</a></dt>

    <dt class="tm"><a href="#keywords">KEYWORDS</a></dt>

    <dd>toggleswitch, widget</dd>
  </dl>

  <div>
    <p><a href="#contents">Contents</a>&nbsp;&nbsp;&nbsp;&nbsp; <a href=
    "index.html">Start page</a></p>
  </div>

  <hr>

  <h2 id="detailed_ref">Detailed Reference</h2>

  <dl>
    <dt id="name"><b>NAME</b></dt>

    <dd><code>tsw::toggleswitch</code> &ndash; Create and manipulate toggle
    switch widgets</dd>

    <dt class="tm" id="synopsis"><b>SYNOPSIS</b></dt>

    <dd>
      <pre>
<b>tsw::toggleswitch</b> <i>pathName</i> ?<i>options</i>?
</pre>
    </dd>

    <dt id="description"><b>DESCRIPTION</b></dt>

    <dd>The <code><b>tsw::toggleswitch</b></code> command creates a new window
    named <code><i>pathName</i></code> and of the class
    <code><b>Toggleswitch</b></code>, and makes it into a <b>toggleswitch</b>
    widget.&nbsp; Additional options, described below, may be specified on the
    command line or in the option database to configure aspects of the
    toggleswitch widget, such as its size and the Tcl script to execute
    whenever the switch state of the widget is toggled.&nbsp; The
    <code><b>tsw::toggleswitch</b></code> command returns its
    <code><i>pathName</i></code> argument.&nbsp; At the time this command is
    invoked, there must not exist a window named <code><i>pathName</i></code>,
    but <code><i>pathName</i></code>'s parent must exist.</dd>

    <dd class="tm">A toggleswitch is a mega-widget consisting of a horizontal
    <b>trough</b> and a <b>slider</b>, just like a ttk::scale widget.&nbsp;
    Actually, these elements belong to a ttk::scale contained in the
    widget.&nbsp; The trough is a fully rounded filled rectangle, and the
    slider is a filled circle contained in the trunk.&nbsp; Both elements are
    rendered using scaling-aware SVG images.&nbsp; Their dimensions depend on
    the display's scaling level, the current theme, and the value of the
    <code><b><a href="#size">-size</a></b></code> configuration option.</dd>

    <dd class="tm">Just like a light switch, a toggleswitch widget can have one
    of two possible <b>switch state</b>s: on or off.&nbsp; In the on state the
    slider is placed at the end of the trough, and in the off state at its
    beginning.&nbsp; As described in the <a href="#bindings">DEFAULT
    BINDINGS</a> section below, the user can toggle between these two states
    with the mouse or the <code>space</code> key.</dd>

    <dd class="tm">The Tcl command associated with a toggleswitch widget has a
    very simple API.&nbsp; You can use the <code><b><a href=
    "#switchstate">switchstate</a></b></code> subcommand to change or query
    the widget's switch state.&nbsp; By using the <code><b><a href=
    "#command">-command</a></b></code> configuration option, you can specify a
    script to execute whenever this subcommand or the convenience one named
    <code><b><a href="#toggle">toggle</a></b></code> causes the widget's switch
    state to get toggled.</dd>

    <dd class="tm">The colors used when drawing the trough and the slider in
    the various widget states (such as <code><b>active</b></code>,
    <code><b>background</b></code>, <code><b>disabled</b></code>,
    <code><b>pressed</b></code>, and <code><b>selected</b></code>) depend on
    the current theme.&nbsp; The implementation contains procedures that create
    these elements for the themes <code><b>aqua</b></code>,
    <code><b>clam</b></code>, <code><b>default</b></code>, and
    <code><b>vista</b></code>.&nbsp; The trough and slider specific to the
    <code><b>vista</b></code> theme are also used for the themes
    <code><b>winnative</b></code> and <code><b>xpnative</b></code>.&nbsp;
    Likewise, the elements specific to the <code><b>default</b></code> theme
    are also used for all the other themes not mentioned above (including the
    third-party ones), except that in dark themes the colors of these elements
    are adapted to the dark background.&nbsp; If the theme is
    <code><b>aqua</b></code> then the colors also depend on the system
    appearance (light mode or dark mode) and the accent color, and are
    automatically adapted whenever one of these global system preferences
    changes.</dd>

    <dt class="tm" id="std_options"><b>STANDARD OPTIONS</b></dt>

    <dd>
      <pre>
<b>-cursor</b>
</pre>
    </dd>

    <dd>See the <b>ttk_widget</b> manual entry for details on the above
    standard option.&nbsp; Its default value is an empty string.</dd>

    <dt class="tm" id="widget_options"><b>WIDGET-SPECIFIC OPTIONS</b></dt>

    <dd id="command">
      <table border="0" cellpadding="0" cellspacing="0">
        <tr>
          <td>Command-Line Name:&nbsp;</td>
          <td><code><b>-command</b></code></td>
        </tr>

        <tr>
          <td>Database Name:</td>
          <td><code><b>&nbsp;command</b></code></td>
        </tr>

        <tr>
          <td>Database Class:</td>
          <td><code><b>&nbsp;Command</b></code></td>
        </tr>
      </table>

      <blockquote>
        <p>Specifies a Tcl script to execute whenever the switch state of the
        widget is toggled (programmatically or interactively).&nbsp; The
        default is an empty string.</p>
      </blockquote>
    </dd>

    <dd id="size">
      <table border="0" cellpadding="0" cellspacing="0">
        <tr>
          <td>Command-Line Name:&nbsp;</td>
          <td><code><b>-size</b></code></td>
        </tr>

        <tr>
          <td>Database Name:</td>
          <td><code><b>&nbsp;size</b></code></td>
        </tr>

        <tr>
          <td>Database Class:</td>
          <td><code><b>&nbsp;Size</b></code></td>
        </tr>
      </table>

      <blockquote>
        <p>Specifies the size identifier of the toggleswitch widget.&nbsp; The
        supported values are the strings <code><b>1</b></code>,
        <code><b>2</b></code>, and <code><b>3</b></code>.&nbsp; If the current
        theme is <code><b>aqua</b></code> then the value <code><b>1</b></code>
        stands for the trough size of 26 x 15 pixels, the value
        <code><b>2</b></code> for the trough size of 32 x 18 pixels, and the
        value <code><b>3</b></code> identifies the trough size of 38 x 22
        pixels.&nbsp; For all the other themes, on an unscaled screen the value
        <code><b>1</b></code> stands for the trough size of 32 x 16 pixels, the
        value <code><b>2</b></code> for the trough size of 40 x 20 pixels, and
        the value <code><b>3</b></code> identifies the trough size of 48 x 24
        pixels, except that on Windows 10 and earlier, for the themes
        <code><b>vista</b></code>, <code><b>winnative</b></code>, and
        <code><b>xpnative</b></code> the unscaled trough width is 35, 44, and
        53 pixels, respectively (for compatibility with the native toggle
        switch).&nbsp; The default is <code><b>2</b></code> (for all
        themes).</p>
      </blockquote>
    </dd>

    <dd id="takefocus">
      <table border="0" cellpadding="0" cellspacing="0">
        <tr>
          <td>Command-Line Name:&nbsp;</td>
          <td><code><b>-takefocus</b></code></td>
        </tr>

        <tr>
          <td>Database Name:</td>
          <td><code><b>&nbsp;takeFocus</b></code></td>
        </tr>

        <tr>
          <td>Database Class:</td>
          <td><code><b>&nbsp;TakeFocus</b></code></td>
        </tr>
      </table>

      <blockquote>
        <p>This option determines whether the toggleswitch widget accepts the
        focus during keyboard traversal.&nbsp; It is almost identical to the
        standard option of the same name (see the <b>options</b> manual entry
        for details).&nbsp; The only difference is that not the toggleswitch
        itself but the ttk::scale widget contained in it will receive the focus
        during keyboard traversal with the standard keys (<code>Tab</code> and
        <code>Shift-Tab</code>).&nbsp; The default is
        <code>"ttk::takefocus"</code> (just like for most Tk themed
        widgets).</p>
      </blockquote>
    </dd>

    <dt class="tm" id="widget_command"><b>WIDGET COMMAND</b></dt>

    <dd>
      The <code><b>tsw::toggleswitch</b></code> command creates a new Tcl
      command whose name is <code><i>pathName</i></code>.&nbsp; This command
      may be used to invoke various operations on the widget.&nbsp; It has the
      following general form:

      <blockquote>
        <pre>
<i>pathName</i> <i>option</i> ?<i>arg</i> <i>arg</i> ...?
</pre>
      </blockquote>
    </dd>

    <dd><code><i>option</i></code> and the <code><i>arg</i></code>s determine
    the exact behavior of the command.&nbsp; The following commands are
    possible for toggleswitch widgets:</dd>

    <dd>
      <dl>
        <dt class="tm" id="attrib"><code><i>pathName</i> <b>attrib</b>
        ?<i>name</i> ?<i>value</i> <i>name</i> <i>value</i> ...??</code></dt>

        <dd>Queries or modifies the attributes of the widget.&nbsp; If no
        <code><i>name</i></code> is specified, the command returns a list of
        pairs, each of which contains the name and the value of an attribute
        for <code><i>pathName</i></code>.&nbsp; If <code><i>name</i></code> is
        specified with no <code><i>value</i></code>, then the command returns
        the value of the one named attribute, or an empty string if no
        corresponding value exists (you can use the <code><b><a href=
        "#hasattrib">hasattrib</a></b></code> subcommand to distinguish this
        case from the one that the value of an <i>existing</i> attribute is an
        empty string).&nbsp; If one or more
        <code><i>name</i></code>-<code><i>value</i></code> pairs are specified,
        then the command sets the given widget attribute(s) to the given
        value(s); in this case the return value is an empty string.&nbsp;
        <code><i>name</i></code> may be an arbitrary string.</dd>

        <dt class="tm" id="cget"><code><i>pathName</i> <b>cget</b>
        <i>option</i></code></dt>

        <dd>Returns the current value of the configuration option given by
        <code><i>option</i></code>, which may have any of the values accepted
        by the <code><b>tsw::toggleswitch</b></code> command.</dd>

        <dt class="tm" id="configure"><code><i>pathName</i> <b>configure</b>
        ?<i>option</i> ?<i>value</i> <i>option</i> <i>value</i>
        ...??</code></dt>

        <dd>Queries or modifies the configuration options of the widget.&nbsp;
        If no <code><i>option</i></code> is specified, the command returns a
        list describing all of the available options for
        <code><i>pathName</i></code> (see <code><b>Tk_ConfigureInfo</b></code>
        for information on the format of this list).&nbsp; If
        <code><i>option</i></code> is specified with no
        <code><i>value</i></code>, then the command returns a list describing
        the one named option (this list will be identical to the corresponding
        sublist of the value returned if no <code><i>option</i></code> is
        specified).&nbsp; If one or more
        <code><i>option</i></code>-<code><i>value</i></code> pairs are
        specified, then the command modifies the given widget option(s) to have
        the given value(s); in this case the return value is an empty
        string.&nbsp; <code><i>option</i></code> may have any of the values
        accepted by the <code><b>tsw::toggleswitch</b></code> command.</dd>

        <dt class="tm" id="hasattrib"><code><i>pathName</i> <b>hasattrib</b>
        <i>name</i></code></dt>

        <dd>Returns <code>1</code> if the attribute <code><i>name</i></code>
        exists and <code>0</code> otherwise.</dd>

        <dt class="tm" id="identify"><code><i>pathName</i> <b>identify</b>
        ?<b>element</b>? <i>x</i> <i>y</i></code></dt>

        <dd>See the <b>ttk_widget</b> manual entry.</dd>

        <dt class="tm" id="instate"><code><i>pathName</i> <b>instate</b>
        <i>stateSpec</i> ?<i>script</i>?</code></dt>

        <dd>See the <b>ttk_widget</b> manual entry.</dd>

        <dt class="tm" id="state"><code><i>pathName</i> <b>state</b>
        ?<i>stateSpec</i>?</code></dt>

        <dd>See the <b>ttk_widget</b> manual entry.</dd>

        <dt class="tm" id="style"><code><i>pathName</i>
        <b>style</b></code></dt>

        <dd>Returns the style used by the ttk::scale widget contained in the
        toggleswitch.&nbsp; This can be one of
        <code><b>Toggleswitch1</b></code>, <code><b>Toggleswitch2</b></code>,
        or <code><b>Toggleswitch3</b></code>, depending on the value of the
        <code><b><a href="#size">-size</a></b></code> option.&nbsp; For Tk
        themed widgets this subcommand was introduced in Tk 8.7a4, but the
        toggleswitch widget provides it for all supported Tk versions.</dd>

        <dt class="tm" id="switchstate"><code><i>pathName</i>
        <b>switchstate</b> ?<i>boolean</i>?</code></dt>

        <dd>Modifies or inquires the widget's switch state.&nbsp; If the
        optional argument is present then it must be a boolean (a numeric
        value, where 0 is false and anything else is true, or a string such as
        <code><b>true</b>/<b>yes</b>/<b>on</b></code> or
        <code><b>false</b>/<b>no</b>/<b>off</b></code>).&nbsp; If it is true
        then the command sets the <code><b>selected</b></code> flag of the
        underlying ttk::scale widget and moves the slider to the end of the
        trough, otherwise it clears the <code><b>selected</b></code> flag
        and moves the slider to the beginning of the trough.&nbsp; If the
        argument's value causes the widget's switch state to get toggled and
        the script specified as the value of the <code><b><a href=
        "#command">-command</a></b></code> option is a nonempty string then the
        command evaluates that script at global scope and returns its result;
        otherwise the return value is an empty string.&nbsp; If the optional
        argument is not present then the command returns the widget's current
        switch state as <code>0</code> or <code>1</code>.&nbsp; When a
        toggleswitch widget is created, its switch state is initialized with
        <code>0</code>.</dd>

        <dt class="tm" id="toggle"><code><i>pathName</i>
        <b>toggle</b></code></dt>

        <dd>
          This convenience subcommand toggles the widget's switch state.&nbsp;
          It is logically equivalent to:

          <blockquote>
            <pre>
if {[<i>pathName</i> switchstate]} {
    return [<i>pathName</i> switchstate 0]
} else {
    return [<i>pathName</i> switchstate 1]
}
</pre>
          </blockquote>
        </dd>

        <dt class="tm" id="unsetattrib"><code><i>pathName</i>
        <b>unsetattrib</b> <i>name</i></code></dt>

        <dd>Unsets the attribute <code><i>name</i></code>.&nbsp; Returns an
        empty string.</dd>
      </dl>
    </dd>

    <dt class="tm" id="bindings"><b>DEFAULT BINDINGS</b></dt>

    <dd>The Tsw package replaces the default bindings of the ttk::scale
    contained in a toggleswitch widget with its own bindings as follows:</dd>

    <dd class="tm">
      If the current theme is <code><b>aqua</b></code>:

      <ol>
        <li class="tm">By pressing mouse button 1 over the slider and then
        dragging the mouse with button 1 down until the pointer enters the
        trough, the slider moves smoothly to the opposite edge of the trough
        and the widget's switch state gets toggled.&nbsp; The same happens if
        mouse button 1 is pressed outside the slider and then the pointer
        leaves the widget horizontally with button 1 down.</li>

        <li class="tm">By pressing mouse button 1 anywhere within the widget
        and then releasing it over the widget without previously moving the
        slider, the latter moves smoothly to the opposite edge of the trough
        and the widget's switch state gets toggled.</li>

        <li class="tm">When the widget has the input focus, the
        <code>space</code> key causes its switch state to get toggled.</li>
      </ol>
    </dd>

    <dd class="tm">
      If the current theme is different from <code><b>aqua</b></code>:

      <ol>
        <li class="tm">By pressing mouse button 1 anywhere within the widget
        and then dragging the mouse with button 1 down, the slider moves in the
        same (horizontal) direction as the pointer.&nbsp; By releasing the
        button, the switch state is set to <code>0</code> or <code>1</code>,
        depending on the slider's position relative to the middle of the
        widget.</li>

        <li class="tm">By pressing mouse button 1 anywhere within the widget
        and then releasing it over the widget without previously dragging the
        mouse horizontally, the widget's switch state gets toggled.</li>

        <li class="tm">When the widget has the input focus, the
        <code>space</code> key causes its switch state to get toggled.</li>
      </ol>
    </dd>

    <dd class="tm">If the widget's <code><b>disabled</b></code> state flag is
    set then none of the above actions occur.</dd>
        
    <dt class="tm" id="keywords"><b>KEYWORDS</b></dt>

    <dd>toggleswitch, widget</dd>
  </dl> 
        
  <div> 
    <p><a href="#contents">Contents</a>&nbsp;&nbsp;&nbsp;&nbsp; <a href=
    "index.html">Start page</a></p>
  </div>
</body> 
</html>

<!DOCTYPE html>
<html>
<head>
  <title>Tsw Programmer's Guide</title>

  <meta name="Author" content="Csaba Nemethi">
  <meta name="Keywords" content="toggleswitch, widget">

  <link rel="stylesheet" type="text/css" href="stylesheet.css">
</head>

<body>
  <div>
    <h1>Tsw Programmer's Guide</h1>

    <h2>For Tsw Version 1.0</h2>
    
    <h3>by</h3>
    
    <h2>Csaba Nemethi</h2>

    <address>
      <a href="mailto:[email protected]">[email protected]</a>
    </address>
  </div>
  
  <hr>

  <h2 id="contents">Contents</h2>

  <h4><a href="#overview">Overview</a></h4>

  <ul>
    <li><a href="#ov_what">What Is Tsw?</a></li>

    <li><a href="#ov_get">How to Get It?</a></li>

    <li><a href="#ov_install">How to Install It?</a></li>

    <li><a href="#ov_use">How to Use It?</a></li>
  </ul>

  <h4><a href="#examples">Examples</a></h4>

  <ul>
    <li><a href="#ex_TswDemo">Tsw Demo</a></li>

    <li><a href="#ex_EditingOpts">Tablelist Editing Options</a></li>
  </ul>

  <div>
    <p><a href="index.html">Start page</a></p>
  </div>

  <hr>

  <h2 id="overview">Overview</h2>

  <h3 id="ov_what">What Is Tsw?</h3>

  <p>Tsw stands for <b>T</b>oggle <b>sw</b>itch and is a library package for
  Tcl/Tk versions 8.6 or higher.&nbsp; If the version is 8.6 then in addition
  it is required that the tksvg extension can be loaded into the interpreter
  (Tk versions 8.7 and 9.0 or higher have built-in SVG support).&nbsp; The
  package is written in pure Tcl/Tk code and contains:</p>

  <ul>
    <li>the implementation of the <a href="toggleswitch.html">toggle switch
    mega-widget <b>toggleswitch</b></a>, including a general utility module for
    mega-widgets;</li>

    <li>two richly commented demo scripts containing the typical steps needed
    to create and handle toggleswitch widgets;</li>

    <li>this tutorial;</li>

    <li>a reference page in HTML format.</li>
  </ul>

  <p>A toggleswitch is a mega-widget consisting of a horizontal trough (a fully
  rounded filled rectangle) and a slider (a filled circle contained in the
  trunk).&nbsp; It can have one of two possible switch states: on or off.&nbsp;
  In the on state the slider is placed at the end of the trough, and in the off
  state at its beginning.&nbsp; The user can toggle between these two states
  with the mouse or the space key.</p>

  <p>You can use the <code><a href=
  "toggleswitch.html#switchstate">switchstate</a></code> subcommand of the Tcl
  command associated with a toggleswitch to change or query the widget's switch
  state.&nbsp; By using the <code><a href=
  "toggleswitch.html#command">-command</a></code> configuration option, you can
  specify a script to execute whenever the switch state of the widget gets
  toggled.</p>

  <h3 id="ov_get">How to Get It?</h3>

  <p>Tsw is available for free download from the Web page</p>

  <blockquote>
    <address>
      <a href="https://www.nemethi.de">https://www.nemethi.de</a>
    </address>
  </blockquote>

  <p>The distribution file is <code>tsw1.0.tar.gz</code> for UNIX and
  <code>tsw1_0.zip</code> for Windows.&nbsp; These files contain the same
  information, except for the additional carriage return character preceding
  the linefeed at the end of each line in the text files for Windows.</p>

  <p>Tsw is also included in tklib, which has the address</p>

  <blockquote>
    <address>
      <a href="https://core.tcl.tk/tklib">https://core.tcl.tk/tklib</a>
    </address>
  </blockquote>

  <h3 id="ov_install">How to Install It?</h3>

  <p>Install the package as a subdirectory of one of the directories given by
  the <code>auto_path</code> variable.&nbsp; For example, you can install it as
  a subdirectory of the <code>lib</code> directory within your Tcl/Tk
  installation (at the same level as the <code>tk8.7</code> or
  <code>tk9.0</code> subdirectory).</p>

  <p>To install Tsw <i>on UNIX</i>, <code>cd</code> to the desired directory
  and unpack the distribution file <code>tsw1.0.tar.gz</code>:</p>
  
  <blockquote>
    <pre>
gunzip -c tsw1.0.tar.gz | tar -xf -
</pre>
  </blockquote>

  <p>On most UNIX systems this can be replaced with</p>

  <blockquote>
    <pre>
tar -zxf tsw1.0.tar.gz
</pre>
  </blockquote>

  <p>Both commands will create a directory named <code>tsw1.0</code>, with the
  subdirectories <code>demos</code>, <code>doc</code>, and
  <code>scripts</code>.</p>

  <p><i>On Windows</i>, use WinZip or some other program capable of unpacking
  the distribution file <code>tsw1_0.zip</code> into the directory
  <code>tsw1.0</code>, with the subdirectories <code>demos</code>,
  <code>doc</code>, and <code>scripts</code>.</p>

  <p>Notice that in tklib the Tsw <code>demos</code> directory is replaced with
  the subdirectory <code>tsw</code> of the <code>examples</code>
  directory.&nbsp; Please take this into account when reading the <a href=
  "#examples">examples</a> below.</p>

  <h3 id="ov_use">How to Use It?</h3>

  <p>To be able to access the commands and variables defined in the Tsw
  package, your scripts must contain one of the lines</p>

  <blockquote>
    <pre>
package require tsw ?<i>version</i>?
package require Tsw ?<i>version</i>?
</pre>
  </blockquote>

  <p>You can use either one of the two statements above because the file
  <code>tsw.tcl</code> contains both lines</p>

  <blockquote>
    <pre>
package provide tsw ...
package provide Tsw ...
</pre>
  </blockquote>

  <p>You are free to remove one of these two lines from <code>tsw.tcl</code> if
  you want to prevent the package from making itself known under two different
  names.&nbsp; Of course, by doing so you restrict the argument of&nbsp;
  <code>package require</code>&nbsp; to a single name.</p>

  <p>Since the Tsw package is implemented in its own namespace called
  <code>tsw</code>, you must either invoke the</p>

  <blockquote>
    <pre>
namespace import tsw::toggleswitch
</pre>
  </blockquote>

  <p>command to import the only public <i>procedure</i> of the <code>tsw</code>
  namespace, or use the qualified name <code>tsw::toggleswitch</code>.&nbsp; In
  the examples below we have chosen the latter approach.</p>

  <p>To access Tsw <i>variables</i>, you <i>must</i> use qualified names.&nbsp;
  There are only two Tsw variables that are designed to be accessed outside the
  <code>tsw</code> namespace:</p>

  <ul>
    <li>The variable <code>tsw::version</code> holds the current version number
    of the Tsw package.</li>

    <li>The variable <code>tsw::library</code> holds the location of the Tsw
    installation directory.</li>
  </ul>

  <div align="center">
    <p><a href="#contents">Contents</a>&nbsp;&nbsp;&nbsp;&nbsp; <a href=
    "index.html">Start page</a></p>
  </div>

  <hr>

  <h2 id="examples">Examples</h2>

  <h3 id="ex_TswDemo">Tsw Demo</h3>

  <p>The script <code>TswDemo.tcl</code> in the <code>demos</code> directory
  creates four <a href="toggleswitch.html">toggleswitch</a> widgets and shows
  how their appearance depends on the current theme, which can be selected with
  the aid of the menu associated with a ttk::menubutton widget.&nbsp; In
  addition, it demonstrates how to specify a script to execute whenever the
  switch state of a toggleswitch gets toggled.</p>

  <blockquote>
    <table border="0" cellspacing="0" cellpadding="0">
      <tr align="center" valign="top">
        <td><img src="TswDemo_aqua_blue.png" alt="Tsw Demo" width="286" height=
        "213"></td>
        <td><img src="TswDemo_aqua_dark.png" alt="Tsw Demo" width="286" height=
        "213"></td>
        <td><img src="TswDemo_aqua_green.png" alt="Tsw Demo" width="286"
        height="213"></td>
      </tr>

      <tr align="center" valign="top">
        <td><img src="TswDemo_default.png" alt="Tsw Demo" width="295" height=
        "227"></td>
        <td><img src="TswDemo_clam.png" alt="Tsw Demo" width="297" height=
        "234"></td>
        <td><img src="TswDemo_vista.png" alt="Tsw Demo" width="272" height=
        "220"></td>
      </tr>
    </table>
  </blockquote>

  <p>Here is the code that creates the four toggleswitch widgets:</p>

  <blockquote>
    <pre>
package require Tk
<span class="red">package require tsw</span>

wm title . "Tsw Demo"

ttk::frame .tf
ttk::frame .bf

<span class="cmt">#
# Create 3 toggleswitch widgets having different values of the -size option
#</span>
set l1 [ttk::label .tf.l1 -text "Toggle switch of size 1"]
<span class="red">set sw1 [tsw::toggleswitch .tf.sw1 -size 1]</span>
set l2 [ttk::label .tf.l2 -text "Toggle switch of size 2"]
<span class="red">set sw2 [tsw::toggleswitch .tf.sw2 -size 2]
$sw2 switchstate 1</span>
set l3 [ttk::label .tf.l3 -text "Toggle switch of size 3"]
<span class="red">set sw3 [tsw::toggleswitch .tf.sw3 -size 3]</span>

<span class="cmt">#
# Create a toggleswitch widget of default size and set its -command option
#</span>
set l4 [ttk::label .tf.l4 -text "Enable/disable above widgets"]
<span class="red">set sw4 [tsw::toggleswitch .tf.sw4]
$sw4 switchstate 1
$sw4 configure -command [list toggleWidgetsState $sw4]</span>
</pre>
  </blockquote>

  <p>We create the toggleswitch widgets by invoking the <code><a href=
  "toggleswitch.html#synopsis">tsw::toggleswitch</a></code> command.&nbsp; For
  the first three toggleswitch widgets we also set the <code><a href=
  "toggleswitch.html#size">-size</a></code> option to <code>1</code>,
  <code>2</code>, and <code>3</code>, respectively.&nbsp; With the exception of
  the themes <code>vista</code>, <code>winnative</code>, and
  <code>xpnative</code>, this results in widgets of different physical
  sizes.&nbsp; For the last toggleswitch we don't explicitly set this option,
  hence it will have its default value <code>2</code>.&nbsp; As seen in the
  screenshots, in the case of the <code>aqua</code> theme the colors used when
  drawing the toggleswitch widgets also depend on the system appearance (light
  mode or dark mode) and the accent color.</p>

  <p>For two of the four toggleswitch widgets we change the switch state from
  the initial value <code>0</code> (off) to <code>1</code> (on) by invoking the
  <code><a href="toggleswitch.html#switchstate">switchstate</a></code>
  subcommand of the associated Tcl command.&nbsp; In addition, for the last
  toggleswitch we set the <code><a href=
  "toggleswitch.html#command">-command</a></code> option to a script that will
  be executed whenever the widget's switch state gets toggled.&nbsp; This
  script invokes the procedure <code>toggleWidgetsState</code> implemented as
  follows:</p>

  <blockquote>
    <pre>
<span class="cmt">#------------------------------------------------------------------------------
# toggleWidgetsState
#
# Enables/disables the widgets in the first 3 grid rows, depending on the
# switch state of the specified toggleswitch widget.
#------------------------------------------------------------------------------</span>
proc toggleWidgetsState sw {
    global l1 l2 l3 sw1 sw2 sw3
    <span class="red">set stateSpec [expr {[$sw switchstate] ? "!disabled" : "disabled"}]</span>
    foreach w [list $l1 $l2 $l3 $sw1 $sw2 $sw3] {
        $w state $stateSpec
    }
}
</pre>
  </blockquote>

  <p>This time the <code>switchstate</code> subcommand is invoked without the
  optional argument, hence it returns the toggleswitch widget's current switch
  state.</p>

  <p>For the <code>default</code> theme, after changing the switch state of the
  last toggleswitch from on to off, the window will look as shown in the
  screenshot below:</p>

  <blockquote>
    <img src="TswDemo_default_2.png" alt="Tsw Demo" width="295" height="227">
  </blockquote>

  <p>The rest of the code is not Tsw-specific and for this reason is not shown
  here.</p>

  <h3 id="ex_EditingOpts">Tablelist Editing Options</h3>

  <p>The script <code>EditingOpts.tcl</code> in the <code>demos</code>
  directory is a slightly adapted version of the Tablelist demo script
  <code>tileWidgets.tcl</code>, which demonstrates the interactive tablelist
  cell editing with the aid of various Ttk widgets.&nbsp; The additional
  functionality in this version is implemented in the procedures
  <code>configEditing</code> and <code>applySwitchState</code>.&nbsp; The first
  one, triggered by the "Configure Editing" button, opens a toplevel window
  containing <a href="toggleswitch.html">toggleswitch</a> widgets for
  configuring the editing-related tablelist options having boolean values,
  proposed over the years by Tablelist users.&nbsp; This is a comfortable way
  to test the effect of setting/clearing these boolean options.</p>

  <blockquote>
    <table border="0" cellspacing="0" cellpadding="0">
      <tr valign="top">
        <td><img src="SerialLineConfig.png" alt="Serial Line Configuration"
        width="686" height="503"></td>
        <td><img src="EditingOpts.png" alt="Editing Options" width="285"
        height="318"></td>
      </tr>
    </table>
  </blockquote>

  <p>The <code>configEditing</code> procedure is shown below:</p>

  <blockquote>
    <pre>
package require Tk
<span class="red">package require tsw</span>
package require tablelist_tile

. . .

<span class="cmt">#------------------------------------------------------------------------------
# configEditing
#
# Configures the editing-related tablelist options having boolean values with
# the aid of toggleswitch widgets.
#------------------------------------------------------------------------------</span>
proc configEditing tbl {
    set top .top
    if {[winfo exists $top]} {
        raise $top
        focus $top
        return ""
    }

    toplevel $top
    wm title $top "Editing Options"

    set tf [ttk::frame $top.tf]
    set bf [ttk::frame $top.bf]

    <span class="cmt">#
    # Create the widgets corresponding to the
    # editing-related options with boolean values
    #</span>
    set row 0
    foreach opt {
        -autofinishediting
        -editendonfocusout
        -editendonmodclick
        -editselectedonly
        -forceeditendcommand
        -instanttoggle
        -showeditcursor
    } {
        lassign [$tbl configure $opt] option dbName dbClass default current
        set defaultStr [expr {$default ? "on" : "off"}]

        set l [ttk::label $tf.l$row -text "$opt ($defaultStr)"]
        if {$current != $default} {
            $l configure -foreground red3
        }
        grid $l -row $row -column 0 -sticky w -padx 9p -pady {0 3p}

        <span class="red">set sw [tsw::toggleswitch $tf.sw$row]
        $sw switchstate $current</span>        ;<span class="cmt"># sets the switch state to $current</span>
        <span class="red">$sw attrib default $default</span>     ;<span class="cmt"># saves $default as attribute value</span>
        <span class="red">$sw configure -command [list applySwitchState $sw $l $tbl $opt]</span>
        grid $sw -row $row -column 1 -sticky w -padx {0 9p} -pady {0 3p}

        incr row
    }

    . . .
}
</pre>
  </blockquote>

  <p>For each of the 7 editing-related options with boolean values, the
  procedure displays the option's name and default value in a ttk::label, and
  sets the <a href="toggleswitch.html#switchstate">switch state</a> of the
  corresponding toggleswitch widget to the option's current value.&nbsp; In
  addition, it invokes the <code><a href=
  "toggleswitch.html#attrib">attrib</a></code> subcommand of the Tcl command
  associated with the toggleswitch to save the default as the value of the
  widget's attribute of name <code>default</code>.&nbsp; In this way, the
  widget "remembers" the default value in an object-oriented manner and can
  retrieve it later without needing any external resources.&nbsp; For increased
  user-friendliness, the label is displayed in the <code>red3</code> foreground
  color if the option's current value is different from the default one.</p>

  <p>Whenever the toggleswitch widget's switch state gets toggled, the script
  specified as the value of its <code><a href=
  "toggleswitch.html#command">-command</a></code> option invokes the
  <code>applySwitchState</code> procedure shown below:</p>

  <blockquote>
    <pre>
<span class="cmt">#------------------------------------------------------------------------------
# applySwitchState
#
# Sets the configuration option opt of the tablelist tbl and the foreground
# color of the ttk::label l according to the switch state of the toggleswitch
# widget sw.
#------------------------------------------------------------------------------</span>
proc applySwitchState {sw l tbl opt} {
    <span class="red">set switchState [$sw switchstate]</span>
    $tbl configure $opt $switchState

    <span class="red">set fgColor [expr {$switchState == [$sw attrib default] ? "" : "red3"}]</span>
    $l configure -foreground $fgColor
}
</pre>
  </blockquote>

  <p>We set the specified tablelist option to the toggleswitch widget's switch
  state, and also the label's foreground color, depending on the switch state
  and the option's default value, which we retrieve by using the
  <code>attrib</code> toggleswitch subcommand.</p>

  <div align="center">
    <p><a href="#contents">Contents</a>&nbsp;&nbsp;&nbsp;&nbsp; <a href=
    "index.html">Start page</a></p>
  </div>
</body>
</html>

#==============================================================================
# Tsw package index file.
#   
# Copyright (c) 2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

#
# Regular package:
# 
package ifneeded tsw 1.0 [list source [file join $dir tsw.tcl]]

#
# Alias:
#   
package ifneeded Tsw 1.0 { package require -exact tsw 1.0 }

#==============================================================================
# Contains procedures that create the Switch*.trough and Switch*.slider
# elements for the Toggleswitch* styles.
#
# Copyright (c) 2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

#------------------------------------------------------------------------------
# tsw::svgFormat
#------------------------------------------------------------------------------
proc tsw::svgFormat {} {
    if {[info exists ::tk::svgFmt]} {			;# Tk 8.7b1/9 or later
	return $::tk::svgFmt
    } else {
	return [list svg -scale [expr {$::scaleutil::scalingPct / 100.0}]]
    }
}

interp alias {} tsw::createSvgImg {} image create photo -format [tsw::svgFormat]

#------------------------------------------------------------------------------
# tsw::createElements_default
#------------------------------------------------------------------------------
proc tsw::createElements_default {} {
    variable elemInfoArr
    if {[info exists elemInfoArr(default)]} {
	return ""
    }

    set troughData(1) {
<svg width="32" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="32" height="16" rx="8" }
    set troughData(2) {
<svg width="40" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="40" height="20" rx="10" }
    set troughData(3) {
<svg width="48" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="48" height="24" rx="12" }

    set sliderData(1) {
<svg width="16" height="12" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="8" cy="6" r="6" fill="#ffffff"/>
</svg>}
    set sliderData(2) {
<svg width="20" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="10" cy="8" r="8" fill="#ffffff"/>
</svg>}
    set sliderData(3) {
<svg width="24" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="12" cy="10" r="10" fill="#ffffff"/>
</svg>}

    foreach n {1 2 3} {
	# troughOffImg
	set imgData $troughData($n)
	append imgData "fill='#c3c3c3'/>\n</svg>"
	set troughOffImg [createSvgImg -data $imgData]

	# troughOffActiveImg
	set imgData $troughData($n)
	append imgData "fill='#b3b3b3'/>\n</svg>"
	set troughOffActiveImg [createSvgImg -data $imgData]

	# troughOffPressedImg
	set imgData $troughData($n)
	append imgData "fill='#a3a3a3'/>\n</svg>"
	set troughOffPressedImg [createSvgImg -data $imgData]

	# troughOffDisabledImg
	set imgData $troughData($n)
	append imgData "fill='#cecece'/>\n</svg>"
	set troughOffDisabledImg [createSvgImg -data $imgData]

	# troughOnImg
	set imgData $troughData($n)
	append imgData "fill='#4a6984'/>\n</svg>"
	set troughOnImg [createSvgImg -data $imgData]

	# troughOnActiveImg
	set imgData $troughData($n)
	append imgData "fill='#587d9e'/>\n</svg>"
	set troughOnActiveImg [createSvgImg -data $imgData]

	# troughOnPressedImg
	set imgData $troughData($n)
	append imgData "fill='#6792b7'/>\n</svg>"
	set troughOnPressedImg [createSvgImg -data $imgData]

	# troughOnDisabledImg
	set imgData $troughData($n)
	append imgData "fill='#abd8ff'/>\n</svg>"
	set troughOnDisabledImg [createSvgImg -data $imgData]

	ttk::style element create Switch$n.trough image [list $troughOffImg \
	    {selected disabled}	$troughOnDisabledImg \
	    {selected pressed}	$troughOnPressedImg \
	    {selected active}	$troughOnActiveImg \
	    selected		$troughOnImg \
	    disabled		$troughOffDisabledImg \
	    pressed		$troughOffPressedImg \
	    active		$troughOffActiveImg \
	]

	# sliderImg
	set sliderImg [createSvgImg -data $sliderData($n)]

	ttk::style element create Switch$n.slider image $sliderImg
    }

    set elemInfoArr(default) 1
}

#------------------------------------------------------------------------------
# tsw::createElements_default-dark
#------------------------------------------------------------------------------
proc tsw::createElements_default-dark {} {
    variable elemInfoArr
    if {[info exists elemInfoArr(default-dark)]} {
	return ""
    }

    set troughData(1) {
<svg width="32" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="32" height="16" rx="8" }
    set troughData(2) {
<svg width="40" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="40" height="20" rx="10" }
    set troughData(3) {
<svg width="48" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="48" height="24" rx="12" }

    set sliderData(1) {
<svg width="16" height="12" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="8" cy="6" r="6" }
    set sliderData(2) {
<svg width="20" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="10" cy="8" r="8" }
    set sliderData(3) {
<svg width="24" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="12" cy="10" r="10" }

    foreach n {1 2 3} {
	# troughOffImg
	set imgData $troughData($n)
	append imgData "fill='#585858'/>\n</svg>"
	set troughOffImg [createSvgImg -data $imgData]

	# troughOffActiveImg
	set imgData $troughData($n)
	append imgData "fill='#676767'/>\n</svg>"
	set troughOffActiveImg [createSvgImg -data $imgData]

	# troughOffPressedImg
	set imgData $troughData($n)
	append imgData "fill='#787878'/>\n</svg>"
	set troughOffPressedImg [createSvgImg -data $imgData]

	# troughOffDisabledImg
	set imgData $troughData($n)
	append imgData "fill='#4a4a4a'/>\n</svg>"
	set troughOffDisabledImg [createSvgImg -data $imgData]

	# troughOnImg
	set imgData $troughData($n)
	append imgData "fill='#6792b7'/>\n</svg>"
	set troughOnImg [createSvgImg -data $imgData]

	# troughOnActiveImg
	set imgData $troughData($n)
	append imgData "fill='#587d9e'/>\n</svg>"
	set troughOnActiveImg [createSvgImg -data $imgData]

	# troughOnPressedImg
	set imgData $troughData($n)
	append imgData "fill='#4a6984'/>\n</svg>"
	set troughOnPressedImg [createSvgImg -data $imgData]

	# troughOnDisabledImg
	set imgData $troughData($n)
	append imgData "fill='#435f78'/>\n</svg>"
	set troughOnDisabledImg [createSvgImg -data $imgData]

	ttk::style element create DarkSwitch$n.trough image [list \
	    $troughOffImg \
	    {selected disabled}	$troughOnDisabledImg \
	    {selected pressed}	$troughOnPressedImg \
	    {selected active}	$troughOnActiveImg \
	    selected		$troughOnImg \
	    disabled		$troughOffDisabledImg \
	    pressed		$troughOffPressedImg \
	    active		$troughOffActiveImg \
	]

	# sliderOffImg
	set imgData $sliderData($n)
	append imgData "fill='#d3d3d3'/>\n</svg>"
	set sliderOffImg [createSvgImg -data $imgData]

	# sliderOffDisabledImg
	set imgData $sliderData($n)
	append imgData "fill='#888888'/>\n</svg>"
	set sliderOffDisabledImg [createSvgImg -data $imgData]

	# sliderOnDisabledImg
	set imgData $sliderData($n)
	append imgData "fill='#9f9f9f'/>\n</svg>"
	set sliderOnDisabledImg [createSvgImg -data $imgData]

	# sliderImg
	set imgData $sliderData($n)
	append imgData "fill='#ffffff'/>\n</svg>"
	set sliderImg [createSvgImg -data $imgData]

	ttk::style element create DarkSwitch$n.slider image [list \
	    $sliderOffImg \
	    {selected disabled}	$sliderOnDisabledImg \
	    selected		$sliderImg \
	    disabled		$sliderOffDisabledImg \
	    pressed		$sliderImg \
	    active		$sliderImg \
	]
    }

    set elemInfoArr(default-dark) 1
}

#------------------------------------------------------------------------------
# tsw::createElements_clam
#------------------------------------------------------------------------------
proc tsw::createElements_clam {} {
    set troughData(1) {
<svg width="32" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="32" height="16" rx="8" }
    set troughData(2) {
<svg width="40" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="40" height="20" rx="10" }
    set troughData(3) {
<svg width="48" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="48" height="24" rx="12" }

    set sliderData(1) {
<svg width="16" height="12" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="8" cy="6" r="6" fill="#ffffff"/>
</svg>}
    set sliderData(2) {
<svg width="20" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="10" cy="8" r="8" fill="#ffffff"/>
</svg>}
    set sliderData(3) {
<svg width="24" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="12" cy="10" r="10" fill="#ffffff"/>
</svg>}

    foreach n {1 2 3} {
	# troughOffImg
	set imgData $troughData($n)
	append imgData "fill='#bab5ab'/>\n</svg>"
	set troughOffImg [createSvgImg -data $imgData]

	# troughOffActiveImg
	set imgData $troughData($n)
	append imgData "fill='#aca79e'/>\n</svg>"
	set troughOffActiveImg [createSvgImg -data $imgData]

	# troughOffPressedImg
	set imgData $troughData($n)
	append imgData "fill='#9e9a91'/>\n</svg>"
	set troughOffPressedImg [createSvgImg -data $imgData]

	# troughOffDisabledImg
	set imgData $troughData($n)
	append imgData "fill='#cbc8c0'/>\n</svg>"
	set troughOffDisabledImg [createSvgImg -data $imgData]

	# troughOnImg
	set imgData $troughData($n)
	append imgData "fill='#4a6984'/>\n</svg>"
	set troughOnImg [createSvgImg -data $imgData]

	# troughOnActiveImg
	set imgData $troughData($n)
	append imgData "fill='#587d9e'/>\n</svg>"
	set troughOnActiveImg [createSvgImg -data $imgData]

	# troughOnPressedImg
	set imgData $troughData($n)
	append imgData "fill='#6792b7'/>\n</svg>"
	set troughOnPressedImg [createSvgImg -data $imgData]

	# troughOnDisabledImg
	set imgData $troughData($n)
	append imgData "fill='#abd8ff'/>\n</svg>"
	set troughOnDisabledImg [createSvgImg -data $imgData]

	ttk::style element create Switch$n.trough image [list $troughOffImg \
	    {selected disabled}	$troughOnDisabledImg \
	    {selected pressed}	$troughOnPressedImg \
	    {selected active}	$troughOnActiveImg \
	    selected		$troughOnImg \
	    disabled		$troughOffDisabledImg \
	    pressed		$troughOffPressedImg \
	    active		$troughOffActiveImg \
	]

	# sliderImg
	set sliderImg [createSvgImg -data $sliderData($n)]

	ttk::style element create Switch$n.slider image $sliderImg
    }
}

#------------------------------------------------------------------------------
# tsw::createElements_vista
#------------------------------------------------------------------------------
proc tsw::createElements_vista {} {
    variable elemInfoArr
    if {[info exists elemInfoArr(vista)]} {
	return ""
    }

    if {$::tcl_platform(osVersion) >= 11.0} {			;# Win 11+
	createElements_win11
    } else {							;# Win 10-
	createElements_win10
    }

    set elemInfoArr(vista) 1
}

#------------------------------------------------------------------------------
# tsw::createElements_win11
#------------------------------------------------------------------------------
proc tsw::createElements_win11 {} {
    set troughOffData(1) {
<svg width="32" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0.5" y="0.5" width="31" height="15" rx="7.5" }
    set troughOffData(2) {
<svg width="40" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0.5" y="0.5" width="39" height="19" rx="9.5" }
    set troughOffData(3) {
<svg width="48" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0.5" y="0.5" width="47" height="23" rx="11.5" }

    set troughOnData(1) {
<svg width="32" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="32" height="16" rx="8" }
    set troughOnData(2) {
<svg width="40" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="40" height="20" rx="10" }
    set troughOnData(3) {
<svg width="48" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="48" height="24" rx="12" }

    set sliderOffData(1) {
<svg width="16" height="10" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="7" cy="5" r="4" }				;# margins L, R: 3, 5
    set sliderOffData(2) {
<svg width="20" height="14" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="9" cy="7" r="6" }				;# margins L, R: 3, 5
    set sliderOffData(3) {
<svg width="24" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="11" cy="9" r="8" }				;# margins L, R: 3, 5

    set sliderOnData(1) {
<svg width="16" height="10" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="9" cy="5" r="4" }				;# margins L, R: 5, 3
    set sliderOnData(2) {
<svg width="20" height="14" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="11" cy="7" r="6" }				;# margins L, R: 5, 3
    set sliderOnData(3) {
<svg width="24" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="13" cy="9" r="8" }				;# margins L, R: 5, 3

    set sliderActiveData(1) {
<svg width="16" height="10" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="8" cy="5" r="5" }				;# margins L, R: 3, 3
    set sliderActiveData(2) {
<svg width="20" height="14" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="10" cy="7" r="7" }				;# margins L, R: 3, 3
    set sliderActiveData(3) {
<svg width="24" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="12" cy="9" r="9" }				;# margins L, R: 3, 3

    set sliderOffPressedData(1) {
<svg width="16" height="10" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="3" y="0" width="13" height="10" rx="5" }	;# margins L, R: 3, 0
    set sliderOffPressedData(2) {
<svg width="20" height="14" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="3" y="0" width="17" height="14" rx="7" }	;# margins L, R: 3, 0
    set sliderOffPressedData(3) {
<svg width="24" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="3" y="0" width="21" height="18" rx="9" }	;# margins L, R: 3, 0

    set sliderOnPressedData(1) {
<svg width="16" height="10" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="13" height="10" rx="5" }	;# margins L, R: 0, 3
    set sliderOnPressedData(2) {
<svg width="20" height="14" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="17" height="14" rx="7" }	;# margins L, R: 0, 3
    set sliderOnPressedData(3) {
<svg width="24" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="21" height="18" rx="9" }	;# margins L, R: 0, 3

    foreach n {1 2 3} {
	# troughOffImg
	set imgData $troughOffData($n)
	append imgData "fill='#f6f6f6' stroke='#8a8a8a'/>\n</svg>"
	set troughOffImg [createSvgImg -data $imgData]

	# troughOffActiveImg
	set imgData $troughOffData($n)
	append imgData "fill='#ededed' stroke='#878787'/>\n</svg>"
	set troughOffActiveImg [createSvgImg -data $imgData]

	# troughOffPressedImg
	set imgData $troughOffData($n)
	append imgData "fill='#e4e4e4' stroke='#858585'/>\n</svg>"
	set troughOffPressedImg [createSvgImg -data $imgData]

	# troughOffDisabledImg
	set imgData $troughOffData($n)
	append imgData "fill='#fbfbfb' stroke='#c5c5c5'/>\n</svg>"
	set troughOffDisabledImg [createSvgImg -data $imgData]

	# troughOnImg
	set imgData $troughOnData($n)
	append imgData "fill='#005fb8'/>\n</svg>"
	set troughOnImg [createSvgImg -data $imgData]

	# troughOnActiveImg
	set imgData $troughOnData($n)
	append imgData "fill='#196ebf'/>\n</svg>"
	set troughOnActiveImg [createSvgImg -data $imgData]

	# troughOnPressedImg
	set imgData $troughOnData($n)
	append imgData "fill='#327ec5'/>\n</svg>"
	set troughOnPressedImg [createSvgImg -data $imgData]

	# troughOnDisabledImg
	set imgData $troughOnData($n)
	append imgData "fill='#c5c5c5'/>\n</svg>"
	set troughOnDisabledImg [createSvgImg -data $imgData]

	ttk::style element create Switch$n.trough image [list $troughOffImg \
	    {selected disabled}	$troughOnDisabledImg \
	    {selected pressed}	$troughOnPressedImg \
	    {selected active}	$troughOnActiveImg \
	    selected		$troughOnImg \
	    disabled		$troughOffDisabledImg \
	    pressed		$troughOffPressedImg \
	    active		$troughOffActiveImg \
	]

	# sliderOffImg
	set imgData $sliderOffData($n)
	append imgData "fill='#5d5d5d'/>\n</svg>"
	set sliderOffImg [createSvgImg -data $imgData]

	# sliderOffActiveImg
	set imgData $sliderActiveData($n)
	append imgData "fill='#5a5a5a'/>\n</svg>"
	set sliderOffActiveImg [createSvgImg -data $imgData]

	# sliderOffPressedImg
	set imgData $sliderOffPressedData($n)
	append imgData "fill='#575757'/>\n</svg>"
	set sliderOffPressedImg [createSvgImg -data $imgData]

	# sliderOffDisabledImg
	set imgData $sliderOffData($n)
	append imgData "fill='#a1a1a1'/>\n</svg>"
	set sliderOffDisabledImg [createSvgImg -data $imgData]

	# sliderOnImg
	set imgData $sliderOnData($n)
	append imgData "fill='#ffffff'/>\n</svg>"
	set sliderOnImg [createSvgImg -data $imgData]

	# sliderOnActiveImg
	set imgData $sliderActiveData($n)
	append imgData "fill='#ffffff'/>\n</svg>"
	set sliderOnActiveImg [createSvgImg -data $imgData]

	# sliderOnPressedImg
	set imgData $sliderOnPressedData($n)
	append imgData "fill='#ffffff'/>\n</svg>"
	set sliderOnPressedImg [createSvgImg -data $imgData]

	# sliderOnDisabledImg
	set imgData $sliderOnData($n)
	append imgData "fill='#ffffff'/>\n</svg>"
	set sliderOnDisabledImg [createSvgImg -data $imgData]

	ttk::style element create Switch$n.slider image [list $sliderOffImg \
	    {selected disabled}	$sliderOnDisabledImg \
	    {selected pressed}	$sliderOnPressedImg \
	    {selected active}	$sliderOnActiveImg \
	    selected		$sliderOnImg \
	    disabled		$sliderOffDisabledImg \
	    pressed		$sliderOffPressedImg \
	    active		$sliderOffActiveImg \
	]
    }
}

#------------------------------------------------------------------------------
# tsw::createElements_win10
#------------------------------------------------------------------------------
proc tsw::createElements_win10 {} {
    set troughOffData(1) {
<svg width="35" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="1" y="1" width="33" height="14" rx="7" stroke-width="2" }
    set troughOffData(2) {
<svg width="44" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="1" y="1" width="42" height="18" rx="9" stroke-width="2" }
    set troughOffData(3) {
<svg width="53" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="1" y="1" width="51" height="22" rx="11" stroke-width="2" }

    set troughOnData(1) {
<svg width="35" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="35" height="16" rx="8" }
    set troughOnData(2) {
<svg width="44" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="44" height="20" rx="10" }
    set troughOnData(3) {
<svg width="53" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="53" height="24" rx="12" }

    set troughPressedData(1) {
<svg width="35" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="35" height="16" rx="8" fill="#666666"/>
</svg>}
    set troughPressedData(2) {
<svg width="44" height="20" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="44" height="20" rx="10" fill="#666666"/>
</svg>}
    set troughPressedData(3) {
<svg width="53" height="24" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <rect x="0" y="0" width="53" height="24" rx="12" fill="#666666"/>
</svg>}

    set sliderData(1) {
<svg width="16" height="8" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="8" cy="4" r="4" }
    set sliderData(2) {
<svg width="20" height="10" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="10" cy="5" r="5" }
    set sliderData(3) {
<svg width="24" height="12" version="1.1" xmlns="http://www.w3.org/2000/svg">
 <circle cx="12" cy="6" r="6" }

    foreach n {1 2 3} {
	# troughOffImg
	set imgData $troughOffData($n)
	append imgData "fill='#ffffff' stroke='#333333'/>\n</svg>"
	set troughOffImg [createSvgImg -data $imgData]

	# troughOffDisabledImg
	set imgData $troughOffData($n)
	append imgData "fill='#ffffff' stroke='#999999'/>\n</svg>"
	set troughOffDisabledImg [createSvgImg -data $imgData]

	# troughOnImg
	set imgData $troughOnData($n)
	append imgData "fill='#0078d7'/>\n</svg>"
	set troughOnImg [createSvgImg -data $imgData]

	# troughOnActiveImg
	set imgData $troughOnData($n)
	append imgData "fill='#4da1e3'/>\n</svg>"
	set troughOnActiveImg [createSvgImg -data $imgData]

	# troughOnDisabledImg
	set imgData $troughOnData($n)
	append imgData "fill='#cccccc'/>\n</svg>"
	set troughOnDisabledImg [createSvgImg -data $imgData]

	# troughPressedImg
	set troughPressedImg [createSvgImg -data $troughPressedData($n)]

	ttk::style element create Switch$n.trough image [list $troughOffImg \
	    {selected disabled}	$troughOnDisabledImg \
	    {selected pressed}	$troughPressedImg \
	    {selected active}	$troughOnActiveImg \
	    selected		$troughOnImg \
	    disabled		$troughOffDisabledImg \
	    pressed		$troughPressedImg \
	]

	# sliderOffImg
	set imgData $sliderData($n)
	append imgData "fill='#333333'/>\n</svg>"
	set sliderOffImg [createSvgImg -data $imgData]

	# sliderOffDisabledImg
	set imgData $sliderData($n)
	append imgData "fill='#999999'/>\n</svg>"
	set sliderOffDisabledImg [createSvgImg -data $imgData]

	# sliderOnImg
	set imgData $sliderData($n)
	append imgData "fill='#ffffff'/>\n</svg>"
	set sliderOnImg [createSvgImg -data $imgData]

	# sliderOnDisabledImg
	set imgData $sliderData($n)
	append imgData "fill='#a3a3a3'/>\n</svg>"
	set sliderOnDisabledImg [createSvgImg -data $imgData]

	# sliderPressedImg
	set imgData $sliderData($n)
	append imgData "fill='#ffffff'/>\n</svg>"
	set sliderPressedImg [createSvgImg -data $imgData]

	ttk::style element create Switch$n.slider image [list $sliderOffImg \
	    {selected disabled}	$sliderOnDisabledImg \
	    selected		$sliderOnImg \
	    disabled		$sliderOffDisabledImg \
	    pressed		$sliderPressedImg \
	]
    }
}

#------------------------------------------------------------------------------
# tsw::createElements_aqua
#------------------------------------------------------------------------------
proc tsw::createElements_aqua {} {
    variable troughImgArr
    variable sliderImgArr

    foreach n {1 2 3} {
	foreach state {off offPressed offDisabled
		       on onPressed onDisabled onBg onDisabledBg} {
	    set troughImgArr(${state}$n) [createSvgImg]
	}

	ttk::style element create Switch$n.trough image [list \
	    $troughImgArr(off$n) \
	    {selected disabled background}	$troughImgArr(onDisabledBg$n) \
	    {selected disabled}			$troughImgArr(onDisabled$n) \
	    {selected background}		$troughImgArr(onBg$n) \
	    {selected pressed}			$troughImgArr(onPressed$n) \
	    selected				$troughImgArr(on$n) \
	    disabled				$troughImgArr(offDisabled$n) \
	    pressed				$troughImgArr(offPressed$n) \
	]

	foreach state {off offPressed offDisabled
		       on onPressed onDisabled} {
	    set sliderImgArr(${state}$n) [createSvgImg]
	}

	ttk::style element create Switch$n.slider image [list \
	    $sliderImgArr(off$n) \
	    {selected disabled}		$sliderImgArr(onDisabled$n) \
	    {selected pressed}		$sliderImgArr(onPressed$n) \
	    selected			$sliderImgArr(on$n) \
	    disabled			$sliderImgArr(offDisabled$n) \
	    pressed			$sliderImgArr(offPressed$n) \
	]
    }

    updateElements_aqua
}

#------------------------------------------------------------------------------
# tsw::updateElements_aqua
#------------------------------------------------------------------------------
proc tsw::updateElements_aqua {} {
    variable troughImgArr
    variable sliderImgArr
    set darkMode [tk::unsupported::MacWindowStyle isdark .]

    set troughOffData(1) {
<svg width="26" height="15" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0.5" y="0.5" width="25" height="14" rx="7" }
    set troughOffData(2) {
<svg width="32" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0.5" y="0.5" width="31" height="17" rx="8.5" }
    set troughOffData(3) {
<svg width="38" height="22" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0.5" y="0.5" width="37" height="21" rx="10.5" }

    set troughOnData(1) {
<svg width="26" height="15" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="26" height="15" rx="7.5" }
    set troughOnData(2) {
<svg width="32" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="32" height="18" rx="9" }
    set troughOnData(3) {
<svg width="38" height="22" version="1.1" xmlns="http://www.w3.org/2000/svg">
<rect x="0" y="0" width="38" height="22" rx="11" }

    set sliderOffData(1) {
<svg width="15" height="15" version="1.1" xmlns="http://www.w3.org/2000/svg">
<circle cx="7.5" cy="7.5" r="7" }
    set sliderOffData(2) {
<svg width="18" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
<circle cx="9" cy="9" r="8.5" }
    set sliderOffData(3) {
<svg width="22" height="22" version="1.1" xmlns="http://www.w3.org/2000/svg">
<circle cx="11" cy="11" r="10.5" }

    set sliderOnData(1) {
<svg width="15" height="15" version="1.1" xmlns="http://www.w3.org/2000/svg">
<circle cx="7.5" cy="7.5" r="6.5" }
    set sliderOnData(2) {
<svg width="18" height="18" version="1.1" xmlns="http://www.w3.org/2000/svg">
<circle cx="9" cy="9" r="8" }
    set sliderOnData(3) {
<svg width="22" height="22" version="1.1" xmlns="http://www.w3.org/2000/svg">
<circle cx="11" cy="11" r="10" }

    foreach n {1 2 3} {
	# troughImgArr(off$n)
	set imgData $troughOffData($n)
	set fill [expr {$darkMode ? "#414141" : "#d9d9d9"}]
	set strk [expr {$darkMode ? "#606060" : "#cdcdcd"}]
	append imgData "fill='$fill' stroke='$strk'/>\n</svg>"
	$troughImgArr(off$n) configure -data $imgData

	# troughImgArr(offPressed$n)
	set imgData $troughOffData($n)
	set fill [expr {$darkMode ? "#4d4d4d" : "#cbcbcb"}]
	set strk [expr {$darkMode ? "#6a6a6a" : "#c0c0c0"}]
	append imgData "fill='$fill' stroke='$strk'/>\n</svg>"
	$troughImgArr(offPressed$n) configure -data $imgData

	# troughImgArr(offDisabled$n)
	set imgData $troughOffData($n)
	set fill [expr {$darkMode ? "#282828" : "#f4f4f4"}]
	set strk [expr {$darkMode ? "#393939" : "#ededed"}]
	append imgData "fill='$fill' stroke='$strk'/>\n</svg>"
	$troughImgArr(offDisabled$n) configure -data $imgData

	# troughImgArr(on$n)
	set imgData $troughOnData($n)
	set fill [expr {$darkMode ? "systemSelectedContentBackgroundColor"
				  : "systemControlAccentColor"}]
	set fill [mwutil::normalizeColor $fill]
	if {$darkMode} {
	    # For the colors blue, purple, pink, red, orange, yellow, green,
	    # and graphite replace $fill with its counterpart for LightAqua
	    array set tmpArr {
		#0059d1 #0064e1  #803482 #7d2a7e  #c93379 #d93b86
		#d13539 #c4262b  #c96003 #d96b0a  #d19e00 #e1ac15
		#43932a #4da033  #696969 #808080
	    }
	    if {[info exists tmpArr($fill)]} { set fill $tmpArr($fill) }
	    array unset tmpArr
	}
	append imgData "fill='$fill'/>\n</svg>"
	$troughImgArr(on$n) configure -data $imgData

	# troughImgArr(onPressed$n)
	set imgData $troughOnData($n)
	set fill [expr {$darkMode ? "systemControlAccentColor"
				  : "systemSelectedContentBackgroundColor"}]
	set fill [mwutil::normalizeColor $fill]
	if {$darkMode} {
	    # For the colors purple, red, yellow, and graphite
	    # replace $fill with its counterpart for LightAqua
	    array set tmpArr {
		#a550a7 #953d96  #ff5257 #e0383e
		#ffc600 #ffc726  #8c8c8c #989898
	    }
	    if {[info exists tmpArr($fill)]} { set fill $tmpArr($fill) }
	    array unset tmpArr
	}
	append imgData "fill='$fill'/>\n</svg>"
	$troughImgArr(onPressed$n) configure -data $imgData

	# troughImgArr(onDisabled$n)
	set imgData $troughOnData($n)
	set fill [mwutil::normalizeColor systemSelectedControlColor]
	append imgData "fill='$fill'/>\n</svg>"
	$troughImgArr(onDisabled$n) configure -data $imgData

	# troughImgArr(onBg$n)
	set imgData $troughOnData($n)
	set fill [expr {$darkMode ? "#676665" : "#b0b0b0"}]
	append imgData "fill='$fill'/>\n</svg>"
	$troughImgArr(onBg$n) configure -data $imgData

	# troughImgArr(onDisabledBg$n)
	set imgData $troughOnData($n)
	set fill [expr {$darkMode ? "#282828" : "#f4f4f4"}]
	append imgData "fill='$fill'/>\n</svg>"
	$troughImgArr(onDisabledBg$n) configure -data $imgData

	# sliderImgArr(off$n)
	set imgData $sliderOffData($n)
	set fill [expr {$darkMode ? "#cacaca" : "#ffffff"}]
	set strk [expr {$darkMode ? "#606060" : "#cdcdcd"}]
	append imgData "fill='$fill' stroke='$strk'/>\n</svg>"
	$sliderImgArr(off$n) configure -data $imgData

	# sliderImgArr(offPressed$n)
	set imgData $sliderOffData($n)
	set fill [expr {$darkMode ? "#e4e4e4" : "#f0f0f0"}]
	set strk [expr {$darkMode ? "#6a6a6a" : "#c0c0c0"}]
	append imgData "fill='$fill' stroke='$strk'/>\n</svg>"
	$sliderImgArr(offPressed$n) configure -data $imgData

	# sliderImgArr(offDisabled$n)
	set imgData $sliderOffData($n)
	set fill [expr {$darkMode ? "#595959" : "#fdfdfd"}]
	set strk [expr {$darkMode ? "#393939" : "#ededed"}]
	append imgData "fill='$fill' stroke='$strk'/>\n</svg>"
	$sliderImgArr(offDisabled$n) configure -data $imgData

	# sliderImgArr(on$n)
	set imgData $sliderOnData($n)
	set fill [expr {$darkMode ? "#cacaca" : "#ffffff"}]
	append imgData "fill='$fill'/>\n</svg>"
	$sliderImgArr(on$n) configure -data $imgData

	# sliderImgArr(onPressed$n)
	set imgData $sliderOnData($n)
	set fill [expr {$darkMode ? "#e4e4e4" : "#f0f0f0"}]
	append imgData "fill='$fill'/>\n</svg>"
	$sliderImgArr(onPressed$n) configure -data $imgData

	# sliderImgArr(onDisabled$n)
	set imgData $sliderOnData($n)
	set fill [expr {$darkMode ? "#595959" : "#fdfdfd"}]
	append imgData "fill='$fill'/>\n</svg>"
	$sliderImgArr(onDisabled$n) configure -data $imgData

	ttk::style layout Toggleswitch$n [list \
	    Switch.padding -sticky nswe -children [list \
		Switch$n.trough -sticky {} -children [list \
		    Switch$n.slider -side left -sticky {} \
		]
	    ]
	]
    }
}

# Tcl autoload index file, version 2.0
# This file is generated by the "auto_mkindex" command
# and sourced to set up indexing information for one or
# more commands.  Typically each line is a command that
# sets an element in the auto_index array, where the
# element name is the name of a command and the value is
# a script that loads the command.

set auto_index(::tsw::svgFormat) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::createElements_default) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::createElements_default-dark) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::createElements_clam) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::createElements_vista) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::createElements_win11) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::createElements_win10) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::createElements_aqua) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::updateElements_aqua) [list source -encoding utf-8 [file join $dir elements.tcl]]
set auto_index(::tsw::condMakeLayouts) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::createBindings) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::toggleswitch) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::doConfig) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::doCget) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::toggleswitchWidgetCmd) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::onThemeChanged) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::onButton1) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::onB1Motion) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::onButtonRel1) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::onSpace) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::startToggling) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::startMovingLeft) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::moveLeft) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::startMovingRight) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::moveRight) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]
set auto_index(::tsw::toggleSwitchState) [list source -encoding utf-8 [file join $dir toggleswitch.tcl]]

#==============================================================================
# Contains the implementation of the toggleswitch widget.
#
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedure creating a new toggleswitch widget
#   - Private configuration procedures
#   - Private procedure implementing the toggleswitch widget command
#   - Private procedures used in bindings
#
# Copyright (c) 2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

#
# Namespace initialization
# ========================
#

namespace eval tsw {
    variable theme [ttk::style theme use]

    #
    # The array configSpecs is used to handle configuration options.  The names
    # of its elements are the configuration options for the Toggleswitch class.
    # The value of an array element is either an alias name or a list
    # containing the database name and class as well as an indicator specifying
    # the widget to which the option applies: f stands for the frame and w for
    # the toggleswitch widget itself.
    #
    #   Command-Line Name	{Database Name	Database Class	W}
    #   ----------------------------------------------------------
    #
    variable configSpecs
    array set configSpecs {
	-command		{command	Command		w}
	-cursor			{cursor		Cursor		f}
	-size			{size		Size		w}
	-takefocus		{takeFocus	TakeFocus	f}
    }

    #
    # Extend the elements of the array configSpecs
    #
    lappend configSpecs(-command)	""
    lappend configSpecs(-cursor)	""
    lappend configSpecs(-size)		2
    lappend configSpecs(-takefocus)	"ttk::takefocus"

    variable configOpts [lsort [array names configSpecs]]

    #
    # Use a list to facilitate the handling of command options
    #
    variable cmdOpts [list attrib cget configure hasattrib identify instate \
		      state style switchstate toggle unsetattrib]

    #
    # Array variable used in binding scripts for the widget class TswScale
    #
    variable stateArr
    set stateArr(dragging) 0

    variable scaled4
    if {[llength [info procs ::tk::ScaleNum]] == 0} {
	#
	# Make sure that the variable ::scaleutil::scalingPct is set
	#
	scaleutil::scalingPercentage [tk windowingsystem]
	set scaled4 [scaleutil::scale 4 $::scaleutil::scalingPct]
    } else {						;# Tk 8.7b1/9 or later
	set scaled4 [tk::ScaleNum 4]
    }

    #
    # Make the layouts
    #
    proc condMakeLayouts {} {
	variable theme
	set themeMod $theme
	set mod ""

	if {$theme == "default"} {
	    set fg [ttk::style lookup . -foreground]
	    if {[mwutil::normalizeColor $fg] eq "#ffffff"} {
		set themeMod default-dark
		set mod "Dark"
	    }
	}

	variable elemInfoArr
	if {[info exists elemInfoArr($themeMod)]} {
	    if {$theme eq "aqua"} {
		updateElements_$theme
	    }

	    return ""
	}

	switch $themeMod {
	    default - default-dark - clam - vista - aqua {
		createElements_$themeMod
	    }
	    winnative - xpnative {
		ttk::style theme settings vista { createElements_vista }
		foreach n {1 2 3} {
		    ttk::style element create Switch$n.trough from vista
		    ttk::style element create Switch$n.slider from vista
		}
	    }
	    default {
		set fg [ttk::style lookup . -foreground]
		if {[mwutil::normalizeColor $fg] eq "#ffffff" ||
		    [string match -nocase *dark* $theme]} {
		    set createCmd createElements_default-dark
		    set mod "Dark"
		} else {
		    set createCmd createElements_default
		}
		ttk::style theme settings default { $createCmd }
		foreach n {1 2 3} {
		    ttk::style element create ${mod}Switch$n.trough from default
		    ttk::style element create ${mod}Switch$n.slider from default
		}
	    }
	}
	set elemInfoArr($themeMod) 1

	if {$theme eq "aqua"} {
	    foreach n {1 2 3} {
		ttk::style layout Toggleswitch$n [list \
		    Switch.padding -sticky nswe -children [list \
			Switch$n.trough -sticky {} -children [list \
			    Switch$n.slider -side left -sticky {} \
			]
		    ]
		]

		ttk::style configure Toggleswitch$n -padding 1.5p
	    }
	} else {
	    foreach n {1 2 3} {
		ttk::style layout Toggleswitch$n [list \
		    Switch.focus -sticky nswe -children [list \
			Switch.padding -sticky nswe -children [list \
			    ${mod}Switch$n.trough -sticky {} -children [list \
				${mod}Switch$n.slider -side left -sticky {}
			    ]
			]
		    ]
		]

		ttk::style configure Toggleswitch$n -padding 0.75p
		if {$theme eq "classic"} {
		    ttk::style configure Toggleswitch$n -focussolid 1
		}
	    }
	}
    }
    condMakeLayouts
}

#
# Private procedure creating the default bindings
# ===============================================
#

#------------------------------------------------------------------------------
# tsw::createBindings
#
# Creates the default bindings for the binding tags Toggleswitch, TswMain,
# ToggleswitchKeyNav, and TswScale.
#------------------------------------------------------------------------------
proc tsw::createBindings {} {
    bind Toggleswitch <KeyPress> continue
    bind Toggleswitch <FocusIn> {
	if {[focus -lastfor %W] eq "%W"} {
	    focus %W.scl
	}
    }
    bind Toggleswitch <Destroy> {
	namespace delete tsw::ns%W
	catch {rename %W ""}
    }
    bind Toggleswitch <<ThemeChanged>> { tsw::onThemeChanged %W }

    bindtags . [linsert [bindtags .] 1 TswMain]
    foreach event {<<ThemeChanged>> <<LightAqua>> <<DarkAqua>>} {
	bind TswMain $event { tsw::onThemeChanged %W }
    }

    #
    # Define the binding tag ToggleswitchKeyNav
    #
    mwutil::defineKeyNav Toggleswitch

    bind TswScale <Enter>	    { %W instate !disabled {%W state active} }
    bind TswScale <Leave>	    { %W state !active }
    bind TswScale <B1-Leave>	    { # Preserves the "active" state. }
    bind TswScale <Button-1>	    { tsw::onButton1	%W %x %y }
    bind TswScale <B1-Motion>	    { tsw::onB1Motion	%W %x %y }
    bind TswScale <ButtonRelease-1> { tsw::onButtonRel1	%W }
    bind TswScale <space>	    { tsw::onSpace	%W }
}

#
# Public procedure creating a new toggleswitch widget
# ===================================================
#

#------------------------------------------------------------------------------
# tsw::toggleswitch
#
# Creates a new toggleswitch widget whose name is specified as the first
# command-line argument, and configures it according to the options and their
# values given on the command line.  Returns the name of the newly created
# widget.
#------------------------------------------------------------------------------
proc tsw::toggleswitch args {
    variable configSpecs
    variable configOpts

    if {[llength $args] == 0} {
	mwutil::wrongNumArgs "tsw::toggleswitch pathName ?options?"
    }

    #
    # Create a ttk::frame of the class Toggleswitch
    #
    set win [lindex $args 0]
    if {[catch {
	ttk::frame $win -class Toggleswitch -borderwidth 0 -relief flat \
			-height 0 -width 0 -padding 0
    } result] != 0} {
	return -code error $result
    }

    #
    # Create a namespace within the current one to hold the data of the widget
    #
    namespace eval ns$win {
	#
	# The following array holds various data for this widget
	#
	variable data
	array set data {
	    moving 0
	    moved  0
	}

	#
	# The following array is used to hold arbitrary
	# attributes and their values for this widget
	#
	variable attribs
    }

    #
    # Initialize some further components of data
    #
    upvar ::tsw::ns${win}::data data
    foreach opt $configOpts {
	set data($opt) [lindex $configSpecs($opt) 3]
    }

    #
    # Create a ttk::scale child widget of a special style
    #
    set size [lindex $configSpecs(-size) end]
    set scl [ttk::scale $win.scl -class TswScale -style Toggleswitch$size \
	     -takefocus 0 -length 0 -from 0 -to 20]
    pack $scl -expand 1 -fill both
    bindtags $scl [linsert [bindtags $scl] 3 ToggleswitchKeyNav]

    #
    # Configure the widget according to the command-line
    # arguments and to the available database options
    #
    if {[catch {
	mwutil::configureWidget $win configSpecs tsw::doConfig tsw::doCget \
	    [lrange $args 1 end] 1
    } result] != 0} {
	destroy $win
	return -code error $result
    }

    #
    # Move the original widget command into the current namespace
    # and build a new widget procedure in the global one
    #
    rename ::$win $win
    interp alias {} ::$win {} tsw::toggleswitchWidgetCmd $win

    return $win
}

#
# Private configuration procedures
# ================================
#

#------------------------------------------------------------------------------
# tsw::doConfig
#
# Applies the value val of the configuration option opt to the toggleswitch
# widget win.
#------------------------------------------------------------------------------
proc tsw::doConfig {win opt val} {
    variable configSpecs
    upvar ::tsw::ns${win}::data data

    #
    # Apply the value to the widget corresponding to the given option
    #
    switch [lindex $configSpecs($opt) 2] {
	f {
	    #
	    # Apply the value to the frame and save the
	    # properly formatted value of val in data($opt)
	    #
	    $win configure $opt $val
	    set data($opt) [$win cget $opt]

	    switch -- $opt {
		-cursor { $win.scl configure $opt $val }
	    }
	}

	w {
	    switch -- $opt {
		-command { set data($opt) $val }
		-size {
		    set val [mwutil::fullOpt "size" $val {1 2 3}]
		    $win.scl configure -style Toggleswitch$val

		    set data($opt) $val
		}
	    }
	}
    }
}

#------------------------------------------------------------------------------
# tsw::doCget
#
# Returns the value of the configuration option opt for the toggleswitch
# widget win.
#------------------------------------------------------------------------------
proc tsw::doCget {win opt} {
    upvar ::tsw::ns${win}::data data
    return $data($opt)
}

#
# Private procedure implementing the toggleswitch widget command
# ==============================================================
#

#------------------------------------------------------------------------------
# tsw::toggleswitchWidgetCmd
#
# Processes the Tcl command corresponding to a toggleswitch widget.
#------------------------------------------------------------------------------
proc tsw::toggleswitchWidgetCmd {win args} {
    set argCount [llength $args]
    if {$argCount == 0} {
        mwutil::wrongNumArgs "$win option ?arg arg ...?"
    }

    variable cmdOpts
    set cmd [mwutil::fullOpt "command" [lindex $args 0] $cmdOpts]
    set argList [lrange $args 1 end]
    set scl $win.scl

    switch $cmd {
	attrib {
	    return [mwutil::attribSubCmdEx "tsw" $win "widget" $argList]
	}

	cget {
	    if {$argCount != 2} {
		mwutil::wrongNumArgs "$win $cmd option"
	    }

	    #
	    # Return the value of the specified configuration option
	    #
	    variable configSpecs
	    set opt [mwutil::fullConfigOpt [lindex $args 1] configSpecs]
	    upvar ::tsw::ns${win}::data data
	    return $data($opt)
	}

	configure {
	    variable configSpecs
	    return [mwutil::configureSubCmd $win configSpecs \
		    tsw::doConfig tsw::doCget $argList]
	}

	hasattrib -
	unsetattrib {
	    if {$argCount != 2} {
		mwutil::wrongNumArgs "$win $cmd name"
	    }

	    return [mwutil::${cmd}SubCmdEx "tsw" $win "widget" [lindex $args 1]]
	}

	identify -
	state {
	    if {[catch {$scl $cmd {*}$argList} result] != 0} {
		return -code error [string map [list $scl $win] $result]
	    }

	    return $result
	}

	instate {
	    if {$argCount < 2 || $argCount > 3} {
		mwutil::wrongNumArgs "$win $cmd stateSpec ?script?"
	    }

	    set stateSpec [lindex $args 1]
	    if {$argCount == 2} {
		return [$scl instate $stateSpec]
	    } elseif {[$scl instate $stateSpec]} {
		set code [catch {uplevel 1 [lindex $args 2]} result]
		return -code $code $result
	    } else {
		return ""
	    }
	}

	style {
	    if {$argCount != 1} {
		mwutil::wrongNumArgs "$win $cmd"
	    }

	    return [$scl cget -style]
	}

	switchstate {
	    if {$argCount < 1 || $argCount > 2} {
		mwutil::wrongNumArgs "$win $cmd ?boolean?"
	    }

	    if {$argCount == 1} {
		return [$scl instate selected]
	    } else {
		set oldSelState [$scl instate selected]
		set newSelState [expr {[lindex $args 1] ? 1 : 0}]
		if {$newSelState} {
		    $scl state selected
		    $scl set [$scl cget -to]
		} else {
		    $scl state !selected
		    $scl set 0
		}

		upvar ::tsw::ns${win}::data data
		if {$newSelState == $oldSelState || $data(-command) eq ""} {
		    return ""
		} else {
		    return [uplevel #0 $data(-command)]
		}
	    }
	}

	toggle {
	    if {$argCount != 1} {
		mwutil::wrongNumArgs "$win $cmd"
	    }

	    set flag [expr {![::$win switchstate]}]
	    return [::$win switchstate $flag]
	}
    }
}

#
# Private procedures used in bindings
# ===================================
#

#------------------------------------------------------------------------------
# tsw::onThemeChanged
#------------------------------------------------------------------------------
proc tsw::onThemeChanged w {
    variable theme [ttk::style theme use]

    if {$w eq "."} {
	condMakeLayouts
    } else {
	set scl $w.scl
	$scl set [expr {[$scl instate selected] ? [$scl cget -to] : 0}]
    }
}

#------------------------------------------------------------------------------
# tsw::onButton1
#------------------------------------------------------------------------------
proc tsw::onButton1 {w x y} {
    $w instate disabled {
	return ""
    }

    $w state pressed

    variable stateArr
    array set stateArr [list  dragging 0  startX $x  prevX $x \
			prevElem [$w identify element $x $y]]

    upvar ::tsw::ns[winfo parent $w]::data data
    set data(moving) 0
    set data(moved) 0
}

#------------------------------------------------------------------------------
# tsw::onB1Motion
#------------------------------------------------------------------------------
proc tsw::onB1Motion {w x y} {
    $w instate disabled {
	return ""
    }

    variable theme
    variable stateArr

    if {$theme eq "aqua"} {
	upvar ::tsw::ns[winfo parent $w]::data data
	if {$data(moving)} {
	    return ""
	}

	set curElem [$w identify element $x $y]
	if {[string match "*.slider" $stateArr(prevElem)] &&
	    [string match "*.trough" $curElem]} {
	    startToggling $w
	} elseif {$x < [winfo x $w]} {
	    startMovingLeft $w
	} elseif {$x >= [winfo x $w] + [winfo width $w]} {
	    startMovingRight $w
	}

	set stateArr(prevElem) $curElem
    } else {
	variable scaled4
	if {!$stateArr(dragging) && abs($x - $stateArr(startX)) > $scaled4} {
	    set stateArr(dragging) 1
	}
	if {!$stateArr(dragging)} {
	    return ""
	}

	lassign [$w coords] curX curY
	set newX [expr {$curX + $x - $stateArr(prevX)}]
	$w set [$w get $newX $curY]

	set stateArr(prevX) $x
    }
}

#------------------------------------------------------------------------------
# tsw::onButtonRel1
#------------------------------------------------------------------------------
proc tsw::onButtonRel1 w {
    $w instate disabled {
	return ""
    }

    variable stateArr
    set win [winfo parent $w]

    if {$stateArr(dragging)} {
	::$win switchstate [expr {[$w get] > [$w cget -to]/2}]
    } elseif {[$w instate hover]} {
	variable theme
	if {$theme eq "aqua"} {
	    upvar ::tsw::ns${win}::data data
	    if {!$data(moving) && !$data(moved)} {
		startToggling $w
	    }
	} else {
	    ::$win toggle
	}
    }

    $w state !pressed
    set stateArr(dragging) 0
}

#------------------------------------------------------------------------------
# tsw::onSpace
#------------------------------------------------------------------------------
proc tsw::onSpace w {
    if {[$w instate disabled] || [$w instate pressed]} {
	return ""
    }

    $w state pressed
    after 200 [list tsw::toggleSwitchState $w]
}

#------------------------------------------------------------------------------
# tsw::startToggling
#------------------------------------------------------------------------------
proc tsw::startToggling w {
    if {[$w get] == 0} {
	startMovingRight $w
    } else {
	startMovingLeft $w
    }
}

#------------------------------------------------------------------------------
# tsw::startMovingLeft
#------------------------------------------------------------------------------
proc tsw::startMovingLeft w {
    if {[$w get] == 0} {
	return ""
    }

    upvar ::tsw::ns[winfo parent $w]::data data
    set data(moving) 1
    $w state !selected		;# will be undone before invoking switchstate
    moveLeft $w [$w cget -to]
}

#------------------------------------------------------------------------------
# tsw::moveLeft
#------------------------------------------------------------------------------
proc tsw::moveLeft {w val} {
    if {![winfo exists $w] || [winfo class $w] ne "TswScale"} {
	return ""
    }

    set val [expr {$val - 1}]
    $w set $val

    if {$val > 0} {
	after 10 [list tsw::moveLeft $w $val]
    } else {
	$w state selected	;# restores the original selected state flag
	set win [winfo parent $w]
	::$win switchstate 0

	upvar ::tsw::ns${win}::data data
	set data(moving) 0
	set data(moved) 1
    }
}

#------------------------------------------------------------------------------
# tsw::startMovingRight
#------------------------------------------------------------------------------
proc tsw::startMovingRight w {
    if {[$w get] == [$w cget -to]} {
	return ""
    }

    upvar ::tsw::ns[winfo parent $w]::data data
    set data(moving) 1
    $w state selected		;# will be undone before invoking switchstate
    moveRight $w 0
}

#------------------------------------------------------------------------------
# tsw::moveRight
#------------------------------------------------------------------------------
proc tsw::moveRight {w val} {
    if {![winfo exists $w] || [winfo class $w] ne "TswScale"} {
	return ""
    }

    set val [expr {$val + 1}]
    $w set $val

    if {$val < [$w cget -to]} {
	after 10 [list tsw::moveRight $w $val]
    } else {
	$w state !selected	;# restores the original !selected state flag
	set win [winfo parent $w]
	::$win switchstate 1

	upvar ::tsw::ns${win}::data data
	set data(moving) 0
	set data(moved) 1
    }
}

#------------------------------------------------------------------------------
# tsw::toggleSwitchState
#------------------------------------------------------------------------------
proc tsw::toggleSwitchState w {
    if {![winfo exists $w] || [winfo class $w] ne "TswScale"} {
	return ""
    }

    ::[winfo parent $w] toggle
    $w state !pressed
}

#==============================================================================
# Contains utility procedures for mega-widgets.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedures
#
# Copyright (c) 2000-2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

if {[catch {package require Tk 8.4-}]} {
    package require Tk 8.4
}

#
# Namespace initialization
# ========================
#

namespace eval mwutil {
    #
    # Public variables:
    #
    variable version	2.24
    variable library	[file dirname [file normalize [info script]]]

    #
    # Public procedures:
    #
    namespace export	wrongNumArgs getAncestorByClass convEventFields \
			defineKeyNav processTraversal focusNext focusPrev \
			configureWidget fullConfigOpt fullOpt enumOpts \
			configureSubCmd attribSubCmdEx attribSubCmd \
			hasattribSubCmdEx hasattribSubCmd unsetattribSubCmdEx \
			unsetattribSubCmd getScrollInfo getScrollInfo2 \
			isScrollable scrollByUnits genMouseWheelEvent \
			containsPointer hasFocus windowingSystem currentTheme \
			normalizeColor parsePadding

    #
    # Make modified versions of the procedures tk_focusNext and
    # tk_focusPrev, to be invoked in the processTraversal command
    #
    proc makeFocusProcs {} {
	#
	# Enforce the evaluation of the Tk library file "focus.tcl"
	#
	tk_focusNext .

	#
	# Build the procedures focusNext and focusPrev
	#
	foreach dir {Next Prev} {
	    set procBody [info body tk_focus$dir]
	    regsub -all {winfo children} $procBody {getChildren $class} procBody
	    proc focus$dir {w class} $procBody
	}
    }
    makeFocusProcs

    #
    # Invoked in the procedures focusNext and focusPrev defined above:
    #
    proc getChildren {class w} {
	if {[winfo class $w] eq $class} {
	    return {}
	} else {
	    return [winfo children $w]
	}
    }
}

package provide mwutil $mwutil::version

#
# Public utility procedures
# =========================
#

#------------------------------------------------------------------------------
# mwutil::wrongNumArgs
#
# Generates a "wrong # args" error message.
#------------------------------------------------------------------------------
proc mwutil::wrongNumArgs args {
    set optList {}
    foreach arg $args {
	lappend optList \"$arg\"
    }
    return -code error "wrong # args: should be [enumOpts $optList]"
}

#------------------------------------------------------------------------------
# mwutil::getAncestorByClass
#
# Gets the path name of the widget of the specified class from the path name w
# of one of its descendants.  It is assumed that all of the ancestors of w
# exist (but w itself needn't exist).
#------------------------------------------------------------------------------
proc mwutil::getAncestorByClass {w class} {
    if {[regexp {^\.[^.]+$} $w]} {
	return [expr {[winfo class .] eq $class ? "." : ""}]
    } elseif {[regexp {^(\..+)\.[^.]+$} $w dummy win]} {
	while {[winfo exists $win]} {
	    if {[winfo class $win] eq $class} {
		return $win
	    } else {
		set win [winfo parent $win]
	    }
	}

	return ""
    } else {
	return ""
    }
}

#------------------------------------------------------------------------------
# mwutil::convEventFields
#
# Gets the path name of the widget of the specified class and the x and y
# coordinates relative to the latter from the path name w of one of its
# descendants and from the x and y coordinates relative to the latter.
#------------------------------------------------------------------------------
proc mwutil::convEventFields {w x y class} {
    set win [getAncestorByClass $w $class]
    set _x  [expr {$x + [winfo rootx $w] - [winfo rootx $win]}]
    set _y  [expr {$y + [winfo rooty $w] - [winfo rooty $win]}]

    return [list $win $_x $_y]
}

#------------------------------------------------------------------------------
# mwutil::defineKeyNav
#
# For a given mega-widget class, the procedure defines the binding tag
# ${class}KeyNav as a partial replacement for "all", by substituting the
# scripts bound to the events <Tab>, <Shift-Tab>, and <<PrevWindow>> with new
# ones which propagate these events to the mega-widget of the given class
# containing the widget to which the event was reported.  (The event
# <Shift-Tab> was replaced with <<PrevWindow>> in Tk 8.3.0.)  This tag is
# designed to be inserted before "all" in the list of binding tags of a
# descendant of a mega-widget of the specified class.
#------------------------------------------------------------------------------
proc mwutil::defineKeyNav class {
    foreach event {<Tab> <Shift-Tab> <<PrevWindow>>} {
	bind ${class}KeyNav $event \
	     [list mwutil::processTraversal %W $class $event]
    }
}

#------------------------------------------------------------------------------
# mwutil::processTraversal
#
# Processes the given traversal event for the mega-widget of the specified
# class containing the widget w if that mega-widget is not the only widget
# receiving the focus during keyboard traversal within its toplevel widget.
#------------------------------------------------------------------------------
proc mwutil::processTraversal {w class event} {
    set win [getAncestorByClass $w $class]

    if {$event eq "<Tab>"} {
	set target [focusNext $win $class]
    } else {
	set target [focusPrev $win $class]
    }

    if {$target ne $win} {
	set focusWin [focus -displayof $win]
	if {$focusWin ne ""} {
	    event generate $focusWin <<TraverseOut>>
	}

	focus $target
	event generate $target <<TraverseIn>>
    }

    return -code break ""
}

#------------------------------------------------------------------------------
# mwutil::configureWidget
#
# Configures the widget win by processing the command-line arguments specified
# in optValPairs and, if the value of initialize is true, also those database
# options that don't match any command-line arguments.
#------------------------------------------------------------------------------
proc mwutil::configureWidget {win configSpecsName configCmd cgetCmd \
			      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} {
	#
	# Process those configuration options that were not
	# given as command-line arguments; use the corresponding
	# values from the option database if available
	#
	foreach opt [lsort [array names configSpecs]] {
	    if {[llength $configSpecs($opt)] == 1 ||
		[lsearch -exact $cmdLineOpts $opt] >= 0} {
		continue
	    }
	    set dbName [lindex $configSpecs($opt) 0]
	    set dbClass [lindex $configSpecs($opt) 1]
	    set dbValue [option get $win $dbName $dbClass]
	    if {$dbValue eq ""} {
		set default [lindex $configSpecs($opt) 3]
		eval $configCmd [list $win $opt $default]
	    } else {
		if {[catch {
		    eval $configCmd [list $win $opt $dbValue]
		} result] != 0} {
		    return -code error $result
		}
	    }
	}
    }

    return ""
}

#------------------------------------------------------------------------------
# mwutil::fullConfigOpt
#
# Returns the full configuration option corresponding to the possibly
# abbreviated option opt.
#------------------------------------------------------------------------------
proc mwutil::fullConfigOpt {opt configSpecsName} {
    upvar $configSpecsName configSpecs

    if {[info exists configSpecs($opt)]} {
	if {[llength $configSpecs($opt)] == 1} {
	    return $configSpecs($opt)
	} else {
	    return $opt
	}
    }

    set optList [lsort [array names configSpecs]]
    set count 0
    foreach elem $optList {
	if {[string first $opt $elem] == 0} {
	    incr count
	    if {$count == 1} {
		set option $elem
	    } else {
		break
	    }
	}
    }

    if {$count == 1} {
	if {[llength $configSpecs($option)] == 1} {
	    return $configSpecs($option)
	} else {
	    return $option
	}
    } elseif {$count == 0} {
	### return -code error "unknown option \"$opt\""
	return -code error \
	       "bad option \"$opt\": must be [enumOpts $optList]"
    } else {
	### return -code error "unknown option \"$opt\""
	return -code error \
	       "ambiguous option \"$opt\": must be [enumOpts $optList]"
    }
}

#------------------------------------------------------------------------------
# mwutil::fullOpt
#
# Returns the full option corresponding to the possibly abbreviated option opt.
#------------------------------------------------------------------------------
proc mwutil::fullOpt {kind opt optList} {
    if {[lsearch -exact $optList $opt] >= 0} {
	return $opt
    }

    set count 0
    foreach elem $optList {
	if {[string first $opt $elem] == 0} {
	    incr count
	    if {$count == 1} {
		set option $elem
	    } else {
		break
	    }
	}
    }

    if {$count == 1} {
	return $option
    } elseif {$count == 0} {
	return -code error \
	       "bad $kind \"$opt\": must be [enumOpts $optList]"
    } else {
	return -code error \
	       "ambiguous $kind \"$opt\": must be [enumOpts $optList]"
    }
}

#------------------------------------------------------------------------------
# mwutil::enumOpts
#
# Returns a string consisting of the elements of the given list, separated by
# commas and spaces.
#------------------------------------------------------------------------------
proc mwutil::enumOpts optList {
    set optCount [llength $optList]
    set n 1
    foreach opt $optList {
	set opt [list $opt]
	if {$n == 1} {
	    set str $opt
	} elseif {$n < $optCount} {
	    append str ", $opt"
	} else {
	    if {$optCount > 2} {
		append str ","
	    }
	    append str " or $opt"
	}

	incr n
    }

    return $str
}

#------------------------------------------------------------------------------
# mwutil::configureSubCmd
#
# This procedure is invoked to process configuration subcommands.
#------------------------------------------------------------------------------
proc mwutil::configureSubCmd {win configSpecsName configCmd cgetCmd argList} {
    upvar $configSpecsName configSpecs

    set argCount [llength $argList]
    if {$argCount > 1} {
	#
	# Set the specified configuration options to the given values
	#
	return [configureWidget $win configSpecs $configCmd $cgetCmd $argList 0]
    } elseif {$argCount == 1} {
	#
	# Return the description of the specified configuration option
	#
	set opt [fullConfigOpt [lindex $argList 0] configSpecs]
	set dbName [lindex $configSpecs($opt) 0]
	set dbClass [lindex $configSpecs($opt) 1]
	set default [lindex $configSpecs($opt) 3]
	return [list $opt $dbName $dbClass $default \
		[eval $cgetCmd [list $win $opt]]]
    } else {
	#
	# Return a list describing all available configuration options
	#
	foreach opt [lsort [array names configSpecs]] {
	    if {[llength $configSpecs($opt)] == 1} {
		set alias $configSpecs($opt)
		lappend result [list $opt $alias]
	    } else {
		set dbName [lindex $configSpecs($opt) 0]
		set dbClass [lindex $configSpecs($opt) 1]
		set default [lindex $configSpecs($opt) 3]
		lappend result [list $opt $dbName $dbClass $default \
				[eval $cgetCmd [list $win $opt]]]
	    }
	}
	return $result
    }
}

#------------------------------------------------------------------------------
# mwutil::attribSubCmdEx
#
# This procedure is invoked to process *attrib subcommands.
#------------------------------------------------------------------------------
proc mwutil::attribSubCmdEx {rootNs win prefix argList} {
    upvar ::${rootNs}::ns${win}::attribs attribs

    set argCount [llength $argList]
    if {$argCount > 1} {
	#
	# Set the specified attributes to the given values
	#
	if {$argCount % 2 != 0} {
	    return -code error "value for \"[lindex $argList end]\" missing"
	}
	foreach {attr val} $argList {
	    set attribs($prefix-$attr) $val
	}
	return ""
    } elseif {$argCount == 1} {
	#
	# Return the value of the specified attribute
	#
	set attr [lindex $argList 0]
	set name $prefix-$attr
	if {[info exists attribs($name)]} {
	    return $attribs($name)
	} else {
	    return ""
	}
    } else {
	#
	# Return the current list of attribute names and values
	#
	set len [string length "$prefix-"]
	set result {}
	foreach name [lsort [array names attribs "$prefix-*"]] {
	    set attr [string range $name $len end]
	    lappend result [list $attr $attribs($name)]
	}
	return $result
    }
}

#------------------------------------------------------------------------------
# mwutil::attribSubCmd
#
# This procedure is invoked to process *attrib subcommands.
#------------------------------------------------------------------------------
proc mwutil::attribSubCmd {win prefix argList} {
    set rootNs [string tolower [winfo class $win]]
    return [attribSubCmdEx $rootNs $win $prefix $argList]
}

#------------------------------------------------------------------------------
# mwutil::hasattribSubCmdEx
#
# This procedure is invoked to process has*attrib subcommands.
#------------------------------------------------------------------------------
proc mwutil::hasattribSubCmdEx {rootNs win prefix attr} {
    upvar ::${rootNs}::ns${win}::attribs attribs

    return [info exists attribs($prefix-$attr)]
}

#------------------------------------------------------------------------------
# mwutil::hasattribSubCmd
#
# This procedure is invoked to process has*attrib subcommands.
#------------------------------------------------------------------------------
proc mwutil::hasattribSubCmd {win prefix attr} {
    set rootNs [string tolower [winfo class $win]]
    return [hasattribSubCmdEx $rootNs $win $prefix $attr]
}

#------------------------------------------------------------------------------
# mwutil::unsetattribSubCmdEx
#
# This procedure is invoked to process unset*attrib subcommands.
#------------------------------------------------------------------------------
proc mwutil::unsetattribSubCmdEx {rootNs win prefix attr} {
    upvar ::${rootNs}::ns${win}::attribs attribs

    set name $prefix-$attr
    if {[info exists attribs($name)]} {
	unset attribs($name)
    }

    return ""
}

#------------------------------------------------------------------------------
# mwutil::unsetattribSubCmd
#
# This procedure is invoked to process unset*attrib subcommands.
#------------------------------------------------------------------------------
proc mwutil::unsetattribSubCmd {win prefix attr} {
    set rootNs [string tolower [winfo class $win]]
    return [unsetattribSubCmdEx $rootNs $win $prefix $attr]
}

#------------------------------------------------------------------------------
# mwutil::getScrollInfo
#
# 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::getScrollInfo argList {
    set argCount [llength $argList]
    set opt [lindex $argList 0]

    if {[string first $opt "moveto"] == 0} {
	if {$argCount != 2} {
	    wrongNumArgs "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 "scroll number units|pages"
	}

	set number [lindex $argList 1]
	format "%f" $number   ;# floating-point number check with error message
	set number [expr {int($number > 0 ? ceil($number) : floor($number))}]
	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::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 [lindex $argList 1]
	format "%f" $number   ;# floating-point number check with error message
	set number [expr {int($number > 0 ? ceil($number) : floor($number))}]
	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::scrollByUnits
#
# Scrolls the widget w along a given axis (x or y) by units.  The number of
# units is obtained by converting the fraction built from the last two
# arguments to an integer, rounded away from 0.
#------------------------------------------------------------------------------
proc mwutil::scrollByUnits {w axis delta divisor} {
    set number [expr {$delta/$divisor}]
    set number [expr {int($number > 0 ? ceil($number) : floor($number))}]
    $w ${axis}view scroll $number units
}

#------------------------------------------------------------------------------
# mwutil::genMouseWheelEvent
#
# Generates a mouse wheel event with the given root coordinates and delta on
# the widget w.
#------------------------------------------------------------------------------
proc mwutil::genMouseWheelEvent {w event rootX rootY delta} {
    set needsFocus [expr {($::tk_version < 8.6 ||
	[package vcompare $::tk_patchLevel "8.6b2"] < 0) &&
	$::tcl_platform(platform) eq "windows"}]

    if {$needsFocus} {
	set focusWin [focus -displayof $w]
	focus $w
    }

    event generate $w $event -rootx $rootX -rooty $rootY -delta $delta

    if {$needsFocus} {
	focus $focusWin
    }
}

#------------------------------------------------------------------------------
# mwutil::containsPointer
#
# Returns a boolean value indicating whether the widget w contains the mouse
# pointer.
#------------------------------------------------------------------------------
proc mwutil::containsPointer w {
    if {![winfo viewable $w]} {
	return 0
    }

    foreach {ptrX ptrY} [winfo pointerxy $w] {}
    set wX [winfo rootx $w]
    set wY [winfo rooty $w]
    return [expr {
	$ptrX >= $wX && $ptrX < $wX + [winfo width  $w] &&
	$ptrY >= $wY && $ptrY < $wY + [winfo height $w]
    }]
}

#------------------------------------------------------------------------------
# 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]
    if {$focusWin eq ""} {
	return 0
    }

    return [expr {
	($w eq "." || [string first $w. $focusWin.] == 0) &&
	[winfo toplevel $w] eq [winfo toplevel $focusWin]
    }]
}

#------------------------------------------------------------------------------
# mwutil::windowingSystem
#
# Returns the windowing system ("x11", "win32", or "aqua").
#------------------------------------------------------------------------------
proc mwutil::windowingSystem {} {
    return [tk windowingsystem]
}

#------------------------------------------------------------------------------
# mwutil::currentTheme
#
# Returns the current tile theme.
#------------------------------------------------------------------------------
proc mwutil::currentTheme {} {
    if {[catch {ttk::style theme use} result] == 0} {
	return $result
    } elseif {[info exists ::ttk::currentTheme]} {
	return $::ttk::currentTheme
    } elseif {[info exists ::tile::currentTheme]} {
	return $::tile::currentTheme
    } else {
	return ""
    }
}

#------------------------------------------------------------------------------
# mwutil::normalizeColor
#
# Returns the representation of a given color in the form "#RRGGBB".
#------------------------------------------------------------------------------
proc mwutil::normalizeColor color {
    foreach {r g b} [winfo rgb . $color] {}
    return [format "#%02x%02x%02x" \
	    [expr {$r >> 8}] [expr {$g >> 8}] [expr {$b >> 8}]]
}

#------------------------------------------------------------------------------
# mwutil::parsePadding
#
# Returns the 4-elements list of pixels corresponding to a given padding
# specification.
#------------------------------------------------------------------------------
proc mwutil::parsePadding {w padding} {
    switch [llength $padding] {
	0 {
	    set l 0; set t 0; set r 0; set b 0
	}
	1 {
	    set l [winfo pixels $w $padding]
	    set t $l; set r $l; set b $l
	}
	2 {
	    foreach {l t} $padding {}
	    set l [winfo pixels $w $l]
	    set t [winfo pixels $w $t]
	    set r $l; set b $t
	}
	3 {
	    foreach {l t r} $padding {}
	    set l [winfo pixels $w $l]
	    set t [winfo pixels $w $t]
	    set r [winfo pixels $w $r]
	    set b $t
	}
	4 {
	    foreach {l t r b} $padding {}
	    set l [winfo pixels $w $l]
	    set t [winfo pixels $w $t]
	    set r [winfo pixels $w $r]
	    set b [winfo pixels $w $b]
	}
	default {
	    return -code error "wrong # elements in padding spec \"$padding\""
	}
    }

    set result [list $l $t $r $b]
    foreach pad $result {
	if {$pad < 0} {
	    return -code error "bad pad value \"$pad\""
	}
    }

    return $result
}

#==============================================================================
# mwutil package index file.
#
# Copyright (c) 2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

package ifneeded mwutil    2.24 [list source [file join $dir mwutil.tcl]]
package ifneeded scaleutil 1.15 [list source [file join $dir scaleutil.tcl]]

#==============================================================================
# Contains scaling-related utility procedures.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedures
#   - Private helper procedures
#
# Copyright (c) 2020-2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

if {[catch {package require Tk 8.4-}]} {
    package require Tk 8.4
}

#
# Namespace initialization
# ========================
#

namespace eval scaleutil {
    #
    # Public variables:
    #
    variable version	1.15
    variable library	[file dirname [file normalize [info script]]]

    #
    # Public procedures:
    #
    namespace export	scalingPercentage scale

    #
    # Makes sure that the scaleutil::setTreeviewRowHeight procedure will be
    # invoked whenever the virtual event <<ThemeChanged>> is received (e.g.,
    # because the value of the Treeview style's -font option has changed),
    # or the virtual event <<TkWorldChanged>> with the user_data field (%d)
    # set to "FontChanged" is received.
    #
    proc createBindings {} {
	set tagList [bindtags .]
	if {[lsearch -exact $tagList "ScaleutilMain"] < 0} {
	    bindtags . [linsert $tagList 1 ScaleutilMain]
	    bind ScaleutilMain <<ThemeChanged>> scaleutil::setTreeviewRowHeight
	    bind ScaleutilMain <<TkWorldChanged>> {
		if {"%d" eq "FontChanged"} {
		    scaleutil::setTreeviewRowHeight
		}
	    }
	}
    }
    variable ttkSupported [expr {[llength [info commands ::ttk::style]] > 0}]
    if {$ttkSupported} {
	createBindings
    }
}

package provide scaleutil $scaleutil::version

#
# Public utility procedures
# =========================
#

#------------------------------------------------------------------------------
# scaleutil::scalingPercentage
#
# Returns the display's current scaling percentage (100, 125, 150, 175, or 200).
#------------------------------------------------------------------------------
proc scaleutil::scalingPercentage winSys {
    variable scalingPct
    if {[info exists ::tk::scalingPct]} {		;# Tk 8.7b1/9 or later
	set scalingPct $::tk::scalingPct
    }
    if {[info exists scalingPct]} {
	return [expr {$scalingPct > 200 ? 200 : $scalingPct}]
    }

    variable ttkSupported
    if {$ttkSupported} {
	#
	# Set the default height of the ttk::treeview rows
	#
	setTreeviewRowHeight
    }

    set pct [expr {[tk scaling] * 75}]
    set origPct $pct

    set onX11 [expr {$winSys eq "x11"}]
    set usingSDL [expr {[info exists ::tk::sdltk] && $::tk::sdltk}]

    if {$onX11 && !$usingSDL} {
	#
	# Try to get the window scaling factor (1 or 2), partly
	# based on https://wiki.archlinux.org/title/HiDPI
	#
	set winScalingFactor 1
	set fontScalingFactor 1
	if {[catch {exec ps -e | grep xfce4-session}] == 0} {		;# Xfce
	    if {[catch {exec xfconf-query -c xsettings \
		 -p /Gdk/WindowScalingFactor} result] == 0} {
		set winScalingFactor $result
		if {$winScalingFactor >= 2} {
		    set fontScalingFactor 2
		}
	    }

	    #
	    # The DPI value can be set in the "Fonts" tab of the "Appearance"
	    # dialog or (on Linux Lite 5+) via the "HiDPI Settings" dialog.
	    #
	} elseif {[catch {exec ps -e | grep mate-session}] == 0} {	;# MATE
	    if {[catch {exec gsettings get org.mate.interface \
		 window-scaling-factor} result] == 0} {
		if {$result == 0} {			;# means: "Auto-detect"
		    #
		    # Try to get winScalingFactor from the cursor size
		    #
		    if {[catch {exec xrdb -query | grep Xcursor.size} result]
			== 0 &&
			[catch {exec gsettings get org.mate.peripherals-mouse \
			 cursor-size} defCursorSize] == 0} {
			set cursorSize [lindex $result 1]
			set winScalingFactor \
			    [expr {($cursorSize + $defCursorSize - 1) /
				    $defCursorSize}]
		    }
		} else {
		    set winScalingFactor $result
		}
	    }

	    #
	    # The DPI value can be set via the "Font Rendering Details"
	    # dialog, which can be opened using the "Details..." button
	    # in the "Fonts" tab of the "Appearance Preferences" dialog.
	    #
	} elseif {[catch {exec ps -e | grep gnome-session}] == 0 &&
		  [catch {exec gsettings get \
		   org.gnome.settings-daemon.plugins.xsettings overrides} \
		   result] == 0 &&
		  [set idx \
		   [string first "'Gdk/WindowScalingFactor'" $result]] >= 0} {
	    ##nagelfar ignore
	    scan [string range $result $idx end] "%*s <%d>" winScalingFactor
	}

	#
	# Get the scaling percentage
	#
	if {$winScalingFactor >= 2} {
	    set pct 200
	} elseif {[catch {exec xrdb -query | grep Xft.dpi} result] == 0} {
	    #
	    # Derive the value of pct from that of the font DPI
	    #
	    set dpi [lindex $result 1]
	    set pct [expr {100.0 * $dpi / 96}]
	} elseif {[catch {exec ps -e | grep gnome-session}] == 0 &&
		  ![info exists ::env(WAYLAND_DISPLAY)] &&
		  [catch {exec xrandr | grep " connected"} result] == 0 &&
		  [catch {open $::env(HOME)/.config/monitors.xml} chan] == 0} {
	    #
	    # Update pct by scanning the file ~/.config/monitors.xml
	    #
	    scanMonitorsFile $result $chan pct
	}
    }

    if {$pct == 100} {
	set scalingPct 100
	return 100
    }

    #
    # Scale the default parameters of the panedwindow sash
    #
    option add *Panedwindow.handlePad		[scale 8 $pct] widgetDefault
    option add *Panedwindow.handleSize		[scale 8 $pct] widgetDefault
    if {$::tk_version >= 8.5} {
	option add *Panedwindow.sashPad		0 widgetDefault
	option add *Panedwindow.sashWidth	[scale 3 $pct] widgetDefault
    } else {
	option add *Panedwindow.sashPad		[scale 2 $pct] widgetDefault
	option add *Panedwindow.sashWidth	[scale 2 $pct] widgetDefault
    }

    #
    # Scale the default size of the scale widget and its slider
    #
    option add *Scale.length		$pct widgetDefault
    option add *Scale.sliderLength	[scale 30 $pct] widgetDefault
    option add *Scale.width		[scale 15 $pct] widgetDefault

    if {$onX11} {
	#
	# Conditionally set Tk's scaling factor according to $pct
	#
	if {$pct != $origPct && ![interp issafe]} {
	    variable keepTkScaling
	    if {!([info exists keepTkScaling] && $keepTkScaling)} {
		tk scaling [expr {$pct / 75.0}]
	    }
	}

	#
	# Conditionally correct and then scale the sizes of the standard fonts
	#
	if {$ttkSupported && !$usingSDL} {
	    scaleX11Fonts $fontScalingFactor
	}

	#
	# Scale the default scrollbar width
	#
	if {$::tk_version >= 8.5} {
	    option add *Scrollbar.width	[scale 11 $pct] widgetDefault
	} else {
	    option add *Scrollbar.width [scale 15 $pct] widgetDefault
	}
    }

    if {$ttkSupported} {
	#
	# Scale the default ttk::scale and ttk::progressbar length
	#
	option add *TScale.length	$pct widgetDefault
	option add *TProgressbar.length	$pct widgetDefault

	#
	# Scale a few styles for the built-in themes
	# "alt", "clam", "classic", and "default"
	#
	foreach theme {alt clam classic default} {
	    scaleStyles_$theme $pct
	}

	#
	# Scale a few styles for the built-in Windows themes
	#
	foreach theme {vista winnative xpnative} {
	    if {[lsearch -exact [ttk::style theme names] $theme] >= 0} {
		scaleStyles_$theme $pct
	    }
	}
    }

    #
    # Save the value of pct rounded to the nearest multiple
    # of 25 that is at least 100, in the variable scalingPct
    #
    for {set scalingPct 100} {1} {incr scalingPct 25} {
	if {$pct < $scalingPct + 12.5} {
	    break
	}
    }

    #
    # For the "vista" and "xpnative" themes work around a bug
    # related to the scaling of ttk::checkbutton and ttk::radiobutton
    # widgets in Tk releases no later than 8.6.10 and 8.7a3
    #
    if {$ttkSupported && $scalingPct > 100 &&
	([package vcompare $::tk_patchLevel "8.6.10"] <= 0 ||
	 ($::tk_version == 8.7 &&
	  [package vcompare $::tk_patchLevel "8.7a3"] <= 0))} {
	foreach theme {vista xpnative} {
	    if {[lsearch -exact [ttk::style theme names] $theme] >= 0} {
		patchWinTheme $theme $scalingPct
	    }
	}
    }

    return [expr {$scalingPct > 200 ? 200 : $scalingPct}]
}

#------------------------------------------------------------------------------
# scaleutil::scale
#
# Scales an integer num according to a given scaling percentage pct (which is
# assumed to be a nonnegative, but not necessarily integer, number).
#------------------------------------------------------------------------------
proc scaleutil::scale {num pct} {
    return [expr {round($num * $pct / 100.0)}]
}

#
# Private helper procedures
# =========================
#

#------------------------------------------------------------------------------
# scaleutil::setTreeviewRowHeight
#
# Sets the default height of the ttk::treeview rows.
#------------------------------------------------------------------------------
proc scaleutil::setTreeviewRowHeight {} {
    set font [ttk::style lookup Treeview -font]
    if {$font eq ""} {
	set font TkDefaultFont
    }

    ttk::style configure Treeview -rowheight \
	[expr {[font metrics $font -linespace] + 2}]
}

#------------------------------------------------------------------------------
# scaleutil::scanMonitorsFile
#
# Updates the scaling percentage by scanning the file ~/.config/monitors.xml.
#------------------------------------------------------------------------------
proc scaleutil::scanMonitorsFile {xrandrResult chan pctName} {
    upvar $pctName pct

    #
    # Get the list of connected outputs reported by xrandr
    #
    set outputList {}
    foreach line [split $xrandrResult "\n"] {
	set idx [string first " " $line]
	set output [string range $line 0 [incr idx -1]]
	lappend outputList $output
    }
    set outputList [lsort $outputList]

    #
    # Get the content of the file ~/.config/monitors.xml
    #
    set str [read $chan]
    close $chan

    #
    # Run over the file's "configuration" sections
    #
    set idx 0
    while {[set idx2 [string first "<configuration>" $str $idx]] >= 0} {
	set idx2 [string first ">" $str $idx2]
	set idx [string first "</configuration>" $str $idx2]
	set config [string range $str [incr idx2] [incr idx -1]]

	#
	# Get the list of connectors within this configuration
	#
	set connectorList {}
	foreach {dummy connector} [regexp -all -inline \
		{<connector>([^<]+)</connector>} $config] {
	    lappend connectorList $connector
	}
	set connectorList [lsort $connectorList]

	#
	# If $outputList and $connectorList are identical then set the
	# variable pct to 100, 200, 300, 400, or 500, depending on the
	# max. scaling within this configuration, and exit the loop
	#
	if {$outputList eq $connectorList} {
	    set maxScaling 1.0
	    foreach {dummy scaling} [regexp -all -inline \
		    {<scale>([^<]+)</scale>} $config] {
		if {$scaling > $maxScaling} {
		    set maxScaling $scaling
		}
	    }

	    foreach n {4 3 2 1 0} {
		if {$maxScaling > $n} {
		    set pct [expr {($n + 1) * 100}]
		    break
		}
	    }

	    break
	}
    }
}

#------------------------------------------------------------------------------
# scaleutil::scaleX11Fonts
#
# If needed, corrects the sizes of the standard fonts on X11 by replacing the
# sizes in pixels contained in the library file ttk/fonts.tcl with sizes in
# points, and then multiplies them with $factor.
#------------------------------------------------------------------------------
proc scaleutil::scaleX11Fonts factor {
    set chan [open $::tk_library/ttk/fonts.tcl]
    set str [read $chan]
    close $chan

    set idx [string first "courier" $str]
    set str [string range $str $idx end]

    set idx [string first "size" $str]
    ##nagelfar ignore
    scan [string range $str $idx end] "%*s %d" size
    set points [expr {$size < 0 ? 9 : $size}]		;# -12 -> 9, else 10
    foreach font {TkDefaultFont TkTextFont TkHeadingFont
		  TkIconFont TkMenuFont} {
	font configure $font -size [expr {$factor * $points}]
    }

    set idx [string first "ttsize" $str]
    ##nagelfar ignore
    scan [string range $str $idx end] "%*s %d" size
    set points [expr {$size < 0 ? 8 : $size}]		;# -10 -> 8, else 9
    foreach font {TkTooltipFont TkSmallCaptionFont} {
	font configure $font -size [expr {$factor * $points}]
    }

    set idx [string first "capsize" $str]
    ##nagelfar ignore
    scan [string range $str $idx end] "%*s %d" size
    set points [expr {$size < 0 ? 11 : $size}]		;# -14 -> 11, else 12
    font configure TkCaptionFont -size [expr {$factor * $points}]

    set idx [string first "fixedsize" $str]
    ##nagelfar ignore
    scan [string range $str $idx end] "%*s %d" size
    set points [expr {$size < 0 ? 9 : $size}]		;# -12 -> 9, else 10
    font configure TkFixedFont -size [expr {$factor * $points}]
}

#------------------------------------------------------------------------------
# scaleutil::scaleStyles_alt
#
# Scales a few styles for the "alt" theme.
#------------------------------------------------------------------------------
proc scaleutil::scaleStyles_alt pct {
    ttk::style theme settings alt {
	set scrlbarWidth [scale 14 $pct]
	ttk::style configure TScrollbar \
	    -arrowsize $scrlbarWidth -width $scrlbarWidth

	set thickness [scale 15 $pct]
	ttk::style configure TScale -groovewidth [scale 4 $pct] \
	    -sliderthickness $thickness

	ttk::style configure TProgressbar -barsize [scale 30 $pct] \
	    -thickness $thickness

	ttk::style configure TCombobox -arrowsize $scrlbarWidth

	set l [scale 2 $pct]; set r [scale 10 $pct]
	ttk::style configure TSpinbox -arrowsize [scale 10 $pct] \
	    -padding [list $l 0 $r 0]				;# {2 0 10 0}

	ttk::style configure TButton -padding [scale 1 $pct]
	ttk::style configure Toolbutton -padding [scale 2 $pct]

	ttk::style configure TMenubutton -arrowsize [scale 5 $pct] \
	    -padding [scale 3 $pct]

	set t [scale 2 $pct]; set r [scale 4 $pct]; set b $t
	set indMargin [list 0 $t $r $b]				;# {0 2 4 2}
	foreach style {TCheckbutton TRadiobutton} {
	    ttk::style configure $style -indicatormargin $indMargin \
		-padding [scale 2 $pct]
	}

	set l [scale 2 $pct]; set t $l; set r [scale 1 $pct]
	set margins [list $l $t $r 0]				;# {2 2 1 0}
	ttk::style configure TNotebook -tabmargins $margins
	ttk::style configure TNotebook.Tab \
	    -padding [list [scale 4 $pct] [scale 2 $pct]]
	ttk::style map TNotebook.Tab -expand [list selected $margins]

	ttk::style configure Sash -sashthickness [scale 5 $pct] \
	    -gripsize [scale 20 $pct]

	#
	# -diameter was replaced with -size in Tk 9.
	#
	set l [scale 2 $pct]; set t $l; set r [scale 4 $pct]; set b $l
	set indMargins [list $l $t $r $b]			;# {2 2 4 2}
	ttk::style configure Item -diameter [scale 9 $pct] \
	    -size [scale 9 $pct] -indicatormargins $indMargins
	ttk::style configure Treeview -indent [scale 20 $pct]
    }
}

#------------------------------------------------------------------------------
# scaleutil::scaleStyles_clam
#
# Scales a few styles for the "clam" theme.
#------------------------------------------------------------------------------
proc scaleutil::scaleStyles_clam pct {
    ttk::style theme settings clam {
	#
	# -gripcount was replaced with -gripsize in Tk 9.
	#
	set gripCount [scale 5 $pct]
	set gripSize [scale 10 $pct]
	set scrlbarWidth [scale 14 $pct]
	ttk::style configure TScrollbar -gripcount $gripCount \
	    -gripsize $gripSize -arrowsize $scrlbarWidth -width $scrlbarWidth

	set sliderLen [scale 30 $pct]
	ttk::style configure TScale -gripcount $gripCount -gripsize $gripSize \
	    -arrowsize $scrlbarWidth -sliderlength $sliderLen

	ttk::style configure TProgressbar -sliderlength $sliderLen \
	    -arrowsize $scrlbarWidth

	ttk::style configure TCombobox -arrowsize $scrlbarWidth

	set l [scale 2 $pct]; set r [scale 10 $pct]
	ttk::style configure TSpinbox -arrowsize [scale 10 $pct] \
	    -padding [list $l 0 $r 0]				;# {2 0 10 0}

	ttk::style configure TButton -padding [scale 5 $pct]
	ttk::style configure Toolbutton -padding [scale 2 $pct]

	ttk::style configure TMenubutton -arrowsize [scale 5 $pct] \
	    -arrowpadding [scale 3 $pct] -padding [scale 5 $pct]

	#
	# The -indicatorsize option was removed in Tk 8.7b1/9.
	#
	set l [scale 1 $pct]; set t $l; set r [scale 4 $pct]; set b $l
	set indMargin [list $l $t $r $b]			;# {1 1 4 1}
	foreach style {TCheckbutton TRadiobutton} {
	    ttk::style configure $style -indicatorsize [scale 10 $pct] \
		-indicatormargin $indMargin -padding [scale 2 $pct]
	}

	set l [scale 6 $pct]; set t [scale 2 $pct]; set r $l; set b $t
	ttk::style configure TNotebook.Tab \
	    -padding [list $l $t $r $b]				;# {6 2 6 2}
	set t [scale 4 $pct]
	ttk::style map TNotebook.Tab \
	    -padding [list selected [list $l $t $r $b]]		;# {6 4 6 2}

	#
	# -gripcount was replaced with -gripsize in Tk 9.
	#
	ttk::style configure Sash -sashthickness [scale 6 $pct] \
	    -gripcount [scale 10 $pct] -gripsize [scale 20 $pct]

	ttk::style configure Heading -padding [scale 3 $pct]
	set l [scale 2 $pct]; set t $l; set r [scale 4 $pct]; set b $l
	set indMargins [list $l $t $r $b]			;# {2 2 4 2}
	ttk::style configure Item -indicatorsize [scale 12 $pct] \
	    -indicatormargins $indMargins
	ttk::style configure Treeview -indent [scale 20 $pct]

	ttk::style configure TLabelframe \
	    -labelmargins [list 0 0 0 [scale 4 $pct]]		;# {0 0 0 4}
    }
}

#------------------------------------------------------------------------------
# scaleutil::scaleStyles_classic
#
# Scales a few styles for the "classic" theme.
#------------------------------------------------------------------------------
proc scaleutil::scaleStyles_classic pct {
    ttk::style theme settings classic {
	if {[ttk::style lookup . -borderwidth] == 1} {
	    set scrlbarWidth [scale 12 $pct]
	} else {
	    set scrlbarWidth [scale 15 $pct]
	}
	ttk::style configure TScrollbar \
	    -arrowsize $scrlbarWidth -width $scrlbarWidth

	set thickness [scale 15 $pct]
	ttk::style configure TScale -sliderlength [scale 30 $pct] \
	    -sliderthickness $thickness

	ttk::style configure TProgressbar -barsize [scale 30 $pct] \
	    -thickness $thickness

	ttk::style configure TCombobox -arrowsize $scrlbarWidth

	set l [scale 2 $pct]; set r [scale 10 $pct]
	ttk::style configure TSpinbox -arrowsize [scale 10 $pct] \
	    -padding [list $l 0 $r 0]				;# {2 0 10 0}

	ttk::style configure TButton -padding {3m 1m}
	ttk::style configure Toolbutton -padding [scale 2 $pct]

	ttk::style configure TMenubutton \
	    -indicatormargin [list [scale 5 $pct] 0] -padding {3m 1m}

	set t [scale 2 $pct]; set r [scale 4 $pct]; set b $t
	set indMargin [list 0 $t $r $b]				;# {0 2 4 2}
	foreach style {TCheckbutton TRadiobutton} {
	    #
	    # -indicatordiameter was renamed to -indicatorsize in Tk 9.
	    #
	    ttk::style configure $style -indicatordiameter [scale 12 $pct] \
		-indicatorsize [scale 12 $pct] -indicatormargin $indMargin
	}

	ttk::style configure TNotebook.Tab -padding {3m 1m}

	ttk::style configure Sash \
	    -sashthickness [scale 6 $pct] -sashpad [scale 2 $pct] \
	    -handlesize [scale 8 $pct] -handlepad [scale 8 $pct]

	set l [scale 2 $pct]; set t $l; set r [scale 4 $pct]; set b $l
	set indMargins [list $l $t $r $b]			;# {2 2 4 2}
	ttk::style configure Item -indicatorsize [scale 12 $pct] \
	    -indicatormargins $indMargins
	ttk::style configure Treeview -indent [scale 20 $pct]
    }
}

#------------------------------------------------------------------------------
# scaleutil::scaleStyles_default
#
# Scales a few styles for the "default" theme.
#------------------------------------------------------------------------------
proc scaleutil::scaleStyles_default pct {
    ttk::style theme settings default {
	set scrlbarWidth [scale 12 $pct]
	ttk::style configure TScrollbar \
	    -arrowsize $scrlbarWidth -width $scrlbarWidth

	if {$::tk_version >= 8.7 &&
	    [package vcompare $::tk_patchLevel "8.7a5"] > 0} {
	    set thickness [scale 4 $pct]
	    ttk::style configure TScale -groovewidth $thickness
	} else {
	    set thickness [scale 15 $pct]
	    ttk::style configure TScale -sliderlength [scale 30 $pct] \
		-sliderthickness $thickness
	}

	ttk::style configure TProgressbar -barsize [scale 30 $pct] \
	    -thickness $thickness

	ttk::style configure TCombobox -arrowsize $scrlbarWidth

	set l [scale 2 $pct]; set r [scale 10 $pct]
	ttk::style configure TSpinbox -arrowsize [scale 10 $pct] \
	    -padding [list $l 0 $r 0]				;# {2 0 10 0}

	ttk::style configure TButton -padding [scale 3 $pct]
	ttk::style configure Toolbutton -padding [scale 2 $pct]

	#
	# -indicatormargin was replaced with
	# -arrowsize and -arrowpadding in Tk 8.7b1/9.
	#
	ttk::style configure TMenubutton \
	    -indicatormargin [list [scale 5 $pct] 0] \
	    -arrowsize [scale 5 $pct] -arrowpadding [scale 3 $pct] \
	    -padding [list [scale 10 $pct] [scale 3 $pct]]

	set t [scale 2 $pct]; set r [scale 4 $pct]; set b $t
	set indMargin [list 0 $t $r $b]				;# {0 2 4 2}
	foreach style {TCheckbutton TRadiobutton} {
	    #
	    # -indicatordiameter was removed in Tk 8.7b1/9.
	    #
	    ttk::style configure $style -indicatordiameter [scale 10 $pct] \
		-indicatormargin $indMargin -padding [scale 1 $pct]
	}

	ttk::style configure TNotebook.Tab \
	    -padding [list [scale 4 $pct] [scale 2 $pct]]

	ttk::style configure Sash -sashthickness [scale 5 $pct] \
	    -gripsize [scale 20 $pct]

	set l [scale 2 $pct]; set t $l; set r [scale 4 $pct]; set b $l
	set indMargins [list $l $t $r $b]			;# {2 2 4 2}
	ttk::style configure Item -indicatorsize [scale 12 $pct] \
	    -indicatormargins $indMargins
	ttk::style configure Treeview -indent [scale 20 $pct]
    }
}

#------------------------------------------------------------------------------
# scaleutil::scaleStyles_vista
#
# Scales a few styles for the "vista" theme.
#------------------------------------------------------------------------------
proc scaleutil::scaleStyles_vista pct {
    ttk::style theme settings vista {
	ttk::style configure TCombobox -padding [scale 2 $pct]

	ttk::style configure TButton -padding [scale 1 $pct]
	ttk::style configure Toolbutton -padding [scale 4 $pct]

	ttk::style configure TMenubutton \
	    -padding [list [scale 8 $pct] [scale 4 $pct]]

	foreach style {TCheckbutton TRadiobutton} {
	    ttk::style configure $style -padding [scale 2 $pct]
	}

	ttk::style configure Sash -sashthickness [scale 5 $pct] \
	    -gripsize [scale 20 $pct]

	set padding [list [scale 4 $pct] 0 0 0]			;# {4 0 0 0}
	ttk::style configure Item -padding $padding
	ttk::style configure Treeview -indent [scale 20 $pct]
    }
}

#------------------------------------------------------------------------------
# scaleutil::scaleStyles_winnative
#
# Scales a few styles for the "winnative" theme.
#------------------------------------------------------------------------------
proc scaleutil::scaleStyles_winnative pct {
    ttk::style theme settings winnative {
	ttk::style configure TScale -groovewidth [scale 4 $pct]

	ttk::style configure TProgressbar -barsize [scale 30 $pct] \
	    -thickness [scale 15 $pct]

	ttk::style configure TCombobox -padding [scale 2 $pct]

	set l [scale 2 $pct]; set r [scale 16 $pct]
	ttk::style configure TSpinbox -padding [list $l 0 $r 0]	;# {2 0 16 0}

	ttk::style configure Toolbutton \
	    -padding [list [scale 8 $pct] [scale 4 $pct]]

	ttk::style configure TMenubutton \
	    -padding [list [scale 8 $pct] [scale 4 $pct]] \
	    -arrowsize [scale 3 $pct]

	set padding [list [scale 2 $pct] [scale 4 $pct]]
	foreach style {TCheckbutton TRadiobutton} {
	    ttk::style configure $style -padding $padding
	}

	ttk::style configure TNotebook.Tab \
	    -padding [list [scale 3 $pct] [scale 1 $pct]]

	ttk::style configure Sash -sashthickness [scale 5 $pct] \
	    -gripsize [scale 20 $pct]

	#
	# -diameter was replaced with -size in Tk 9.
	#
	set l [scale 2 $pct]; set t $l; set r [scale 4 $pct]; set b $l
	set indMargins [list $l $t $r $b]			;# {2 2 4 2}
	ttk::style configure Item -diameter [scale 9 $pct] \
	    -size [scale 9 $pct] -indicatormargins $indMargins
	ttk::style configure Treeview -indent [scale 20 $pct]
    }
}

#------------------------------------------------------------------------------
# scaleutil::scaleStyles_xpnative
#
# Scales a few styles for the "vista" and "xpnative" themes.
#------------------------------------------------------------------------------
proc scaleutil::scaleStyles_xpnative pct {
    ttk::style theme settings xpnative {
	ttk::style configure TCombobox -padding [scale 2 $pct]

	set l [scale 2 $pct]; set r [scale 14 $pct]
	ttk::style configure TSpinbox -padding [list $l 0 $r 0]	;# {2 0 14 0}

	ttk::style configure TButton -padding [scale 1 $pct]
	ttk::style configure Toolbutton -padding [scale 4 $pct]

	ttk::style configure TMenubutton \
	    -padding [list [scale 8 $pct] [scale 4 $pct]]

	foreach style {TCheckbutton TRadiobutton} {
	    ttk::style configure $style -padding [scale 2 $pct]
	}

	ttk::style configure Sash -sashthickness [scale 5 $pct] \
	    -gripsize [scale 20 $pct]

	#
	# -diameter was replaced with -size in Tk 9.
	#
	set l [scale 2 $pct]; set t $l; set r [scale 4 $pct]; set b $l
	set indMargins [list $l $t $r $b]			;# {2 2 4 2}
	ttk::style configure Item -diameter [scale 9 $pct] \
	    -size [scale 9 $pct] -indicatormargins $indMargins
	ttk::style configure Treeview -indent [scale 20 $pct]
    }
}

#------------------------------------------------------------------------------
# scaleutil::patchWinTheme
#
# Works around a bug related to the scaling of ttk::checkbutton and
# ttk::radiobutton widgets in the "vista" and "xpnative" themes.
#------------------------------------------------------------------------------
proc scaleutil::patchWinTheme {theme pct} {
    ttk::style theme settings $theme {
	#
	# Create the Checkbutton.vsapi_ind and Radiobutton.vsapi_ind
	# elements.  Due to the way the vsapi element factory is
	# implemented, we have to set the -height and -width options
	# to half of the desired element height and width, respectively.
	#
	if {$pct > 350} {
	    set pct 350
	}
	array set arr {125 8   150 10  175 10  200 13  225 13}
	array set arr {250 16  275 16  300 20  325 20  350 20}
	set height $arr($pct)
	set pad [scale 2 $pct]
	set width [expr {$height + 2*$pad}]
	if {[lsearch -exact [ttk::style element names] \
	     "Checkbutton.vsapi_ind"]  < 0} {
	    ttk::style element create Checkbutton.vsapi_ind vsapi BUTTON 3 {
		{alternate disabled} 12  {alternate pressed} 11
		{alternate active} 10  alternate 9
		{selected disabled} 8  {selected pressed} 7
		{selected active} 6  selected 5
		disabled 4  pressed 3  active 2  {} 1
	    } -height $height -width $width
	}
	if {[lsearch -exact [ttk::style element names] \
	     "Radiobutton.vsapi_ind"]  < 0} {
	    ttk::style element create Radiobutton.vsapi_ind vsapi BUTTON 2 {
		{alternate disabled} 4  alternate 1
		{selected disabled} 8  {selected pressed} 7
		{selected active} 6  selected 5
		disabled 4  pressed 3  active 2  {} 1
	    } -height $height -width $width
	}

	#
	# Redefine the TCheckbutton and TRadiobutton layouts
	#
	ttk::style layout TCheckbutton {
	    Checkbutton.padding -sticky nswe -children {
		Checkbutton.vsapi_ind -side left -sticky ""
		Checkbutton.focus -side left -sticky w -children {
		    Checkbutton.label -sticky nswe
		}
	    }
	}
	ttk::style layout TRadiobutton {
	    Radiobutton.padding -sticky nswe -children {
		Radiobutton.vsapi_ind -side left -sticky ""
		Radiobutton.focus -side left -sticky w -children {
		    Radiobutton.label -sticky nswe
		}
	    }
	}

	#
	# Patch the padding of TCheckbutton and TRadiobutton, so widgets of
	# these styles will look as if they had a uniform padding of 2, as
	# set in the library files ttk/xpTheme.tcl and ttk/vistaTheme.tcl
	#
	set padding [list -$pad $pad $pad $pad]
	ttk::style configure TCheckbutton -padding $padding
	ttk::style configure TRadiobutton -padding $padding
    }
}

#==============================================================================
# Main Tsw package module. 
#
# Copyright (c) 2025  Csaba Nemethi (E-mail: [email protected])
#==============================================================================

namespace eval tsw {
    proc - {} { return [expr {$::tcl_version >= 8.5 ? "-" : ""}] }

    package require Tk 8.6[-]

    if {$::tk_version == 8.6} {
	package require tksvg
    }

    #
    # Public variables:
    #
    variable version    1.0
    variable library    [file dirname [file normalize [info script]]]

    #
    # Creates a new toggleswitch widget:
    #
    namespace export	toggleswitch
}

package provide tsw $tsw::version
package provide Tsw $tsw::version

#
# Everything else needed is lazily loaded on demand, via the dispatcher
# set up in the subdirectory "scripts" (see the file "tclIndex").
#
lappend auto_path [file join $tsw::library scripts]

#
# Load the packages mwutil and (conditionally) scaleutil from
# the directory "scripts/utils".  Take into account that mwutil
# is also included in Mentry, Scrollutil, and Tablelist, and
# scaleutil is also included in Scrollutil and Tablelist.
#
proc tsw::loadUtils {} {
    if {[catch {package present mwutil} version] == 0 &&
        [package vcompare $version 2.24] < 0} {
        package forget mwutil
    }
    package require mwutil 2.24[-]

    if {[info exists ::tk::svgFmt]} {			;# Tk 8.7b1/9 or later
	return ""
    }

    if {[catch {package present scaleutil} version] == 0 &&
	[package vcompare $version 1.15] < 0} {
	package forget scaleutil
    }
    package require scaleutil 1.15[-]
}
tsw::loadUtils

tsw::createBindings

Module style         _tcl  _man  _null
Module swaplist      _tcl  _man  _null
Module tablelist     _tab  _null _exa
Module text          _tcl  _null _null
Module tkpiechart    _tcl  _man  _exa
Module tooltip       _tcl  _man  _null
Module treeview      _tcl  _null _null
Module tsw           _tab  _null _exa
Module wcb           _tab  _null _exa
Module widget        _tcl  _man  _exa
Module widgetPlus    _tcl  _man  _exa
Module widgetl       _tcli _man  _null
Module widgetv       _tcl  _man  _null

Application  diagram-viewer