# application scaling
  tclsh demottk.tcl winxpblue -fontscale 1.2
  # tk scaling only
  tclsh demottk.tcl winxpblue -ttkscale 2.0
  # user with high dpi, smaller font
  tclsh demottk.tcl winxpblue -ttkscale 2.0 -fontscale 0.7




7.2 (2019-12-2)
   - setBackground will not do anything if the background color is unchanged.
   - fixed a bug with graphical buttons.
   - make setbackground more robust.

7.1 (2019-12-1)
   - fix border/padding scaling, needed for rounded buttons/tabs.

  # application scaling
  tclsh demottk.tcl winxpblue -fontscale 1.2
  # tk scaling only
  tclsh demottk.tcl winxpblue -ttkscale 2.0
  # user with high dpi, smaller font
  tclsh demottk.tcl winxpblue -ttkscale 2.0 -fontscale 0.7

7.3 (2019-12-2)
   - fix spinbox scaled styling

7.2 (2019-12-2)
   - setBackground will not do anything if the background color is unchanged.
   - fixed a bug with graphical buttons.
   - make setbackground more robust.

7.1 (2019-12-1)
   - fix border/padding scaling, needed for rounded buttons/tabs.

#   To style the scrollbars, use:
#        ttk::scrollbar .sb -style Vertical.TScrollbar
#     or ttk::scrollbar .sb -style Horizontal.TScrollbar
#   This will turn off the aqua styling and use the theme styling.
#   Also note that the styling for the scrollbar cannot be configured
#     afterwards, it must be configured when the scrollbar is created.
#


# 7.2
#   - setBackground will not do anything if the background color is unchanged.
#   - fixed a bug with graphical buttons.
#   - make setbackground more robust.
# 7.1
#   - fix border/padding scaling, needed for rounded buttons/tabs.
# 7.0
#   - clean up .svg files to use alpha channel for disabled colors.
#   - calculate some disabled colors.
#   - fix doc.
#   - split out theme specific code into separate files.
#   - Fix scaledStyle set of treeview indicator.
#   - make the tab topbar a generalized option.
#   - merge themeutils package
#   - clean up notebook tabs.
#   - winxpblue: notebook tab graphics.
#   - winxpblue: disabled images.
#   - black: disabled cb/rb images.
#   - black: add labelframe color.
# 6.0
#   - fix !focus colors
#   - slider border color
#   - various styling fixes and improvements
#   - separate scrollbar color
#   - optional scrollbar grip
#   - button images are now supported
#   - added winxpblue scalable theme
................................................................................
#   - added setMenuColors helper routine
#   - cleaned up the radiobutton image
#   - resized checkbutton and radiobutton images.
# 0.1
#   - initial coding
#

package provide awthemes 7.2

package require Tk
# set ::notksvg to true for testing purposes
if { ! [info exists ::notksvg] || ! $::notksvg } {
  catch { package require tksvg }
}

................................................................................
          disabled  $images(spin-arrow-bg-up-d${sfx})]
      ttk::style element create ${pfx}Spinbox.downarrow image \
          [list $images(spin-arrow-bg-down-n${sfx}) \
          disabled  $images(spin-arrow-bg-down-d${sfx})]

      if { $pfx ne {} } {
        set layout [ttk::style layout TSpinbox]
        regsub {(Spinbox.[a-z]*arrow)} $layout "${pfx}\\1" layout

        ttk::style layout ${pfx}TSpinbox $layout
      }
    }

    ttk::style configure ${pfx}TSpinbox \
        -borderwidth 1 \
        -relief none \

#   To style the scrollbars, use:
#        ttk::scrollbar .sb -style Vertical.TScrollbar
#     or ttk::scrollbar .sb -style Horizontal.TScrollbar
#   This will turn off the aqua styling and use the theme styling.
#   Also note that the styling for the scrollbar cannot be configured
#     afterwards, it must be configured when the scrollbar is created.
#
# 7.3 (2019-12-2)
#   - fix spinbox scaled styling
# 7.2 (2019-12-2)
#   - setBackground will not do anything if the background color is unchanged.
#   - fixed a bug with graphical buttons.
#   - make setbackground more robust.
# 7.1 (2019-12-1)
#   - fix border/padding scaling, needed for rounded buttons/tabs.
# 7.0 (2019-11-30)
#   - clean up .svg files to use alpha channel for disabled colors.
#   - calculate some disabled colors.
#   - fix doc.
#   - split out theme specific code into separate files.
#   - Fix scaledStyle set of treeview indicator.
#   - make the tab topbar a generalized option.
#   - merge themeutils package
#   - clean up notebook tabs.
#   - winxpblue: notebook tab graphics.
#   - winxpblue: disabled images.
#   - black: disabled cb/rb images.
#   - black: add labelframe color.
# 6.0 (2019-11-23)
#   - fix !focus colors
#   - slider border color
#   - various styling fixes and improvements
#   - separate scrollbar color
#   - optional scrollbar grip
#   - button images are now supported
#   - added winxpblue scalable theme
................................................................................
#   - added setMenuColors helper routine
#   - cleaned up the radiobutton image
#   - resized checkbutton and radiobutton images.
# 0.1
#   - initial coding
#

package provide awthemes 7.3

package require Tk
# set ::notksvg to true for testing purposes
if { ! [info exists ::notksvg] || ! $::notksvg } {
  catch { package require tksvg }
}

................................................................................
          disabled  $images(spin-arrow-bg-up-d${sfx})]
      ttk::style element create ${pfx}Spinbox.downarrow image \
          [list $images(spin-arrow-bg-down-n${sfx}) \
          disabled  $images(spin-arrow-bg-down-d${sfx})]

      if { $pfx ne {} } {
        set layout [ttk::style layout TSpinbox]
        regsub {(Spinbox.uparrow)} $layout "${pfx}\\1" layout
        regsub {(Spinbox.downarrow)} $layout "${pfx}\\1" layout
        ttk::style layout ${pfx}TSpinbox $layout
      }
    }

    ttk::style configure ${pfx}TSpinbox \
        -borderwidth 1 \
        -relief none \

#!/usr/bin/tclsh

package require Tk

if { 1 } {
  set ap [file normalize [file join [file dirname [info script]] .. code]]
  if { $ap ni $::auto_path } {
    lappend ::auto_path $ap
  }
  unset ap
}

if { [llength $::argv] < 1 } {
  puts "Usage: demottk.tcl <theme> \[-ttkscale <scale-factor>] \[-scale <scale-factor>] \[-fontscale <scale-factor>] \[-highlightcolor <color>] \[-notksvg]"
  exit 1
}

lappend ::auto_path [file dirname [info script]]

set theme [lindex $::argv 0]

set ::notksvg false
set fontscale 1.0 ; # default
set sf 1.0
set gc {}
for {set idx 1} {$idx < [llength $::argv]} {incr idx} {
  if { [lindex $::argv $idx] eq "-ttkscale" } {
    incr idx
    tk scaling [lindex $::argv $idx]
  }
  if { [lindex $::argv $idx] eq "-scale" } {
    incr idx
    set sf [lindex $::argv $idx]
  }
  if { [lindex $::argv $idx] eq "-highlightcolor" } {
    incr idx
    set gc [lindex $::argv $idx]
  }
  if { [lindex $::argv $idx] eq "-fontscale" } {
    incr idx
    set fontscale [lindex $::argv $idx]
  }
  if { [lindex $::argv $idx] eq "-notksvg" } {
    set ::notksvg true
  }
}

# now do the requires so that -notksvg has an effect.
package require colorutils
package require awthemes

if { $gc ne {} } {
  ::themeutils::setThemeColors $theme \
      graphics.color $gc
}
::themeutils::setThemeColors $theme \
    scale.factor $sf

if { ! $::notksvg } {
  catch { package require tksvg }
}

set fn data/bll-tecra/tkscale.txt
if { [file exists $fn] } {
  set fh [open $fn r]
  set scale [gets $fh]
  close $fh
  tk scaling -displayof . $scale
}

set calcdpi [expr {round([tk scaling]*72.0)}]
set scalefactor [expr {$calcdpi/100.0}]

# Tk defaults to pixels.  Sigh.
# Use points so that the fonts scale.
font configure TkDefaultFont -size 11
set origfontsz [font metrics TkDefaultFont -ascent]
font configure TkDefaultFont -size [expr {round(12.0*$fontscale)}]

set newfontsz [font metrics TkDefaultFont -ascent]
if { $origfontsz != $newfontsz } {
  set appscale [expr {double($newfontsz)/double($origfontsz)}]
  ::themeutils::setThemeColors $theme \
      scale.factor $appscale
}

set loaded false
if { 1 } {
  set fn [file join $::env(HOME) s ballroomdj code themes themeloader.tcl]
  if { [file exists $fn] } {
    source $fn
    themeloader::loadTheme $theme
    set loaded true
  }
}

set havetksvg false
if { ! [catch {package present tksvg}] } {
  set havetksvg true
}

set ttheme $theme
if { ($havetksvg && $theme eq "black") ||
    ($havetksvg && $theme eq "winxpblue") } {
  set ttheme aw${theme}
}
if { [file exists $ttheme.tcl] && ! $loaded } {
  source $ttheme.tcl
}

ttk::style theme use $theme

set val 55
set valb $theme
set off 0
set on 1

. configure -background [ttk::style lookup TFrame -background]

if { [info commands ::ttk::theme::${theme}::scaledStyle] ne {} } {
  font create SmallFont
  font configure SmallFont -size [expr {round(8.0*$fontscale)}]
  ttk::theme::${theme}::scaledStyle Small TkDefaultFont SmallFont
}

ttk::style configure TFrame -borderwidth 0

foreach {k} {{} Small} {
  set tfont TkDefaultFont
  set s {}
  if { $k ne {} } {
    set tfont SmallFont
    set s Small.
  }

  ttk::labelframe .lf${k} \
      -text " Normal " \
      -style ${s}TLabelframe
  ttk::style configure ${s}TLabelframe.Label -font $tfont

  ttk::frame .bf$k
  ttk::label .lb$k -text $theme -style ${s}TLabel
  ttk::style configure ${s}TLabel -font $tfont
  ttk::button .b$k -text $theme -style ${s}TButton
  ttk::style configure ${s}TButton -font $tfont
  pack .lb$k .b$k -in .bf$k -side left -padx 3p

  ttk::combobox .combo$k -values \
      [list aaa bbb ccc ddd eee fff ggg hhh iii jjj kkk lll mmm nnn ooo ppp] \
      -textvariable valb \
      -width 15 \
      -height 5 \
      -font $tfont \
      -style ${s}TCombobox
  option add *TCombobox*Listbox.font $tfont

  ttk::frame .cbf$k
  ttk::checkbutton .cboff$k -text off -variable off -style ${s}TCheckbutton
  ttk::checkbutton .cbon$k -text on -variable on -style ${s}TCheckbutton
  pack .cboff$k .cbon$k -in .cbf$k -side left -padx 3p

  ttk::separator .sep$k -style ${s}TSeparator

  ttk::frame .rbf$k
  ttk::radiobutton .rboff$k -text off -variable on -value 0 -style ${s}TRadiobutton
  ttk::radiobutton .rbon$k -text on -variable on -value 1 -style ${s}TRadiobutton
  pack .rboff$k .rbon$k -in .rbf$k -side left -padx 3p

  pack .bf$k .combo$k .cbf$k .sep$k .rbf$k \
      -in .lf$k -side top -anchor w -padx 3p -pady 3p
  pack configure .sep$k -fill x -expand true

  ttk::frame .hf$k
  ttk::scale .sc$k \
      -from 0 \
      -to 100 \
      -variable val \
      -length [expr {round(100*$scalefactor)}] \
      -style ${s}Horizontal.TScale
  ttk::progressbar .pb$k \
      -mode determinate \
      -variable val \
      -length [expr {round(100*$scalefactor)}] \
      -style ${s}Horizontal.TProgressbar
  ttk::entry .ent$k -textvariable valb \
      -width 15 \
      -font $tfont \
      -style ${s}TEntry
  ttk::spinbox .sbox$k -textvariable val \
      -width 5 \
      -from 1 -to 100 -increment 0.1 \
      -font $tfont \
      -style ${s}TSpinbox
  pack .sc$k .pb$k .ent$k .sbox$k \
      -in .hf$k -side top -anchor w -padx 3p -pady 3p

  ttk::frame .vf$k
  ttk::scale .scv$k \
      -orient vertical \
      -from 0 -to 100 \
      -variable val \
      -length [expr {round(100*$scalefactor)}] \
      -style ${s}Vertical.TScale
  ttk::progressbar .pbv$k -orient vertical \
      -mode determinate \
      -variable val \
      -length [expr {round(100*$scalefactor)}] \
      -style ${s}Vertical.TProgressbar
  pack .scv$k .pbv$k -in .vf$k -side right -padx 3p -pady 3p

  pack .hf$k .vf$k -in .lf$k -side left -anchor e
}
.lfSmall configure -text " Scaled "
pack .lf .lfSmall -in . -side left -padx 3p -pady 3p -expand 1 -fill both

package ifneeded awthemes 7.2 \
    [list source [file join $dir awthemes.tcl]] 
package ifneeded colorutils 4.4 \
    [list source [file join $dir colorutils.tcl]] 

package ifneeded awdark 7.0 \
    [list source [file join $dir awdark.tcl]]
package ifneeded awlight 7.0 \

package ifneeded awthemes 7.3 \
    [list source [file join $dir awthemes.tcl]] 
package ifneeded colorutils 4.4 \
    [list source [file join $dir colorutils.tcl]] 

package ifneeded awdark 7.0 \
    [list source [file join $dir awdark.tcl]]
package ifneeded awlight 7.0 \

2019-11-12 Harald Oehlmann <oehhar@users.sourceforge.net>
	spinbox.tcl: fix error about unsupported option
	-disabledforeground when using themed widgets.
	Thanks to Gerhard Reithofer and Christian Werner.
	Ticket [071fc80f14]

2019-05-06 Harald Oehlmann <oehhar@users.sourceforge.net>

2019-12-03 Harald Oehlmann <oehhar@users.sourceforge.net>

	**** BWidget 1.9.14 tagged ****

2019-11-12 Harald Oehlmann <oehhar@users.sourceforge.net>
	spinbox.tcl: fix error about unsupported option
	-disabledforeground when using themed widgets.
	Thanks to Gerhard Reithofer and Christian Werner.
	Ticket [071fc80f14]

2019-05-06 Harald Oehlmann <oehhar@users.sourceforge.net>

if {[catch {package require Tcl}]} return
# NOTE: auto_loaded top-level commands shall not be qualified (no leading ::)
# but all others should.  See auto_qualify for details.
package ifneeded BWidget 1.9.13 "\
    package require Tk 8.1.1;\
    [list tclPkgSetup $dir BWidget 1.9.13 {
	{arrow.tcl       source {ArrowButton ::ArrowButton::create ::ArrowButton::use}}
	{labelframe.tcl  source {LabelFrame ::LabelFrame::create ::LabelFrame::use}}
	{labelentry.tcl  source {LabelEntry ::LabelEntry::create ::LabelEntry::use}}
	{bitmap.tcl      source {::Bitmap::get ::Bitmap::use}}
	{button.tcl      source {Button ::Button::create ::Button::use}}
	{buttonbox.tcl   source {ButtonBox ::ButtonBox::create ::ButtonBox::use}}
	{combobox.tcl    source {ComboBox ::ComboBox::create ::ComboBox::use}}

if {[catch {package require Tcl}]} return
# NOTE: auto_loaded top-level commands shall not be qualified (no leading ::)
# but all others should.  See auto_qualify for details.
package ifneeded BWidget 1.9.14 "\
    package require Tk 8.1.1;\
    [list tclPkgSetup $dir BWidget 1.9.14 {
	{arrow.tcl       source {ArrowButton ::ArrowButton::create ::ArrowButton::use}}
	{labelframe.tcl  source {LabelFrame ::LabelFrame::create ::LabelFrame::use}}
	{labelentry.tcl  source {LabelEntry ::LabelEntry::create ::LabelEntry::use}}
	{bitmap.tcl      source {::Bitmap::get ::Bitmap::use}}
	{button.tcl      source {Button ::Button::create ::Button::use}}
	{buttonbox.tcl   source {ButtonBox ::ButtonBox::create ::ButtonBox::use}}
	{combobox.tcl    source {ComboBox ::ComboBox::create ::ComboBox::use}}

###############################################################################
##                                                                           ##
##  Copyright (c) 2016-2017, Harald Oehlmann                                 ##
##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
................................................................................
package require Tcl 8.4
package require WS::Utils 2.4 ; # dict, lassign, logsubst
package require tdom 0.8
package require http 2
package require log
package require uri

package provide WS::Client 2.6.0

namespace eval ::WS::Client {
    # register https only if not yet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        if {[catch {
            package require tls
................................................................................
    set body [::http::data $token]
    ::log::logsubst info {\nReceived: $body}
    set results {}
    if {[::http::status $token] ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [FormatHTTPError $token]

    } else {
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }


    ##
    ## Call the appropriate callback
    ##
    if {$hadError} {
        set cmd $errorCmd
        lappend cmd $errorCode $errorInfo
    } else {
        set cmd $succesCmd
    }

    lappend cmd $results
    catch $cmd



    ##
    ## All done
    ##
    ::http::cleanup $token
    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#

###############################################################################
##                                                                           ##
##  Copyright (c) 2016-2019, Harald Oehlmann                                 ##
##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
................................................................................
package require Tcl 8.4
package require WS::Utils 2.4 ; # dict, lassign, logsubst
package require tdom 0.8
package require http 2
package require log
package require uri

package provide WS::Client 2.6.3

namespace eval ::WS::Client {
    # register https only if not yet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        if {[catch {
            package require tls
................................................................................
    set body [::http::data $token]
    ::log::logsubst info {\nReceived: $body}
    set results {}
    if {[::http::status $token] ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set results [FormatHTTPError $token]
        set errorInfo ""
    } else {
        SaveAndSetOptions $serviceName
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        RestoreSavedOptions $serviceName




        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }
    ::http::cleanup $token

    ##
    ## Call the appropriate callback
    ##
    if {$hadError} {
        set cmd $errorCmd
        lappend cmd $errorCode $errorInfo
    } else {
        set cmd $succesCmd
    }
    if {$cmd ne ""} {
        lappend cmd $results
        if {[catch $cmd cmdErr]} {
            ::log::log error "Error invoking callback '$cmd': $cmdErr" 
        }
    }
    ##
    ## All done
    ##

    return
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#

# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.6.0 [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Embeded 2.6.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Embedded 2.6.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.6.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.6.2 [list source [file join $dir Utilities.tcl]]
package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]

# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.6.3 [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Embeded 2.6.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Embedded 2.6.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.6.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.6.2 [list source [file join $dir Utilities.tcl]]
package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]