Bwidget Source Code
View Ticket
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.
Ticket UUID: 4b6a27c9b855b6450347def5c9a72e0f0171eaec
Title: Widget::theme 1 -> TitleFrame fails
Type: Bug Version: 1.9.10
Submitter: anonymous Created on: 2016-08-23 19:14:08
Subsystem: bwidget 1.x Assigned To: nobody
Priority: 5 Medium Severity: Minor
Status: Pending Last Modified: 2016-10-31 14:51:57
Resolution: Works For Me Closed By: nobody
    Closed on:
Description:
When trying to run the demo using "Widget::theme 1" the TitleFrame widget fails.

Pls. see following source code, where I added the usual "if {[Widget::theme]} {..."
code block to support ttk:: widgets.

Would be glad, if this get's fixed.
With kind regards,
  Johann Oberdorfer

# ------------------------------------------------------------------------------
#  titleframe.tcl
#  This file is part of Unifix BWidget Toolkit
# ------------------------------------------------------------------------------
#  Index of commands:
#     - TitleFrame::create
#     - TitleFrame::configure
#     - TitleFrame::cget
#     - TitleFrame::getframe
#     - TitleFrame::_place
# ------------------------------------------------------------------------------

namespace eval TitleFrame {
    Widget::define TitleFrame titleframe

    Widget::declare TitleFrame {
        {-relief      TkResource groove 0 frame}
        {-borderwidth TkResource 2      0 frame}
        {-font        TkResource ""     0 label}
        {-foreground  TkResource ""     0 label}
        {-state       TkResource ""     0 label}
        {-background  TkResource ""     0 frame}
        {-text        String     ""     0}
        {-ipad        Int        4      0 "%d >=0"}
        {-side        Enum       left   0 {left center right}}
        {-baseline    Enum       center 0 {top center bottom}}
        {-fg          Synonym    -foreground}
        {-bg          Synonym    -background}
        {-bd          Synonym    -borderwidth}
    }

    Widget::addmap TitleFrame "" :cmd {-background {}}
    Widget::addmap TitleFrame "" .l   {
    	-background {} -foreground {} -text {} -font {}
    }
    Widget::addmap TitleFrame "" .l   {-state {}}
    Widget::addmap TitleFrame "" .p   {-background {}}
    Widget::addmap TitleFrame "" .b   {
    	-background {} -relief {} -borderwidth {}
    }
    Widget::addmap TitleFrame "" .b.p {-background {}}
    Widget::addmap TitleFrame "" .f   {-background {}}
}


# ------------------------------------------------------------------------------
#  Command TitleFrame::create
# ------------------------------------------------------------------------------
proc TitleFrame::create { path args } {
    Widget::init TitleFrame $path $args

	if {[Widget::theme]} {

      set frame [eval [list ttk::frame $path] [Widget::subcget $path :cmd] -relief flat \
	        -class TitleFrame]

      set padtop [eval [list ttk::frame $path.p] [Widget::subcget $path :cmd] -relief flat]
      set border [eval [list ttk::frame $path.b] [Widget::subcget $path .b]]
      set label  [eval [list ttk::label $path.l] [Widget::subcget $path .l] -relief flat]
      set padbot [eval [list ttk::frame $border.p] [Widget::subcget $path .p] -relief flat]
      set frame  [eval [list ttk::frame $path.f] [Widget::subcget $path .f] -relief flat]

	} else {

      set frame  [eval [list frame $path] [Widget::subcget $path :cmd] \
	      -class TitleFrame -relief flat -bd 0 -highlightthickness 0]

      set padtop [eval [list frame $path.p] [Widget::subcget $path :cmd] \
	      -relief flat -borderwidth 0]
      set border [eval [list frame $path.b] [Widget::subcget $path .b] -highlightthickness 0]
      set label  [eval [list label $path.l] [Widget::subcget $path .l] \
                      -highlightthickness 0 \
                      -relief flat \
                      -bd     0 -padx 2 -pady 0]
      set padbot [eval [list frame $border.p] [Widget::subcget $path .p] \
	      -relief flat -bd 0 -highlightthickness 0]
      set frame  [eval [list frame $path.f] [Widget::subcget $path .f] \
	      -relief flat -bd 0 -highlightthickness 0]

	}

    set height [winfo reqheight $label]

    switch [Widget::getoption $path -side] {
        left   { set relx 0.0; set x 5;  set anchor nw }
        center { set relx 0.5; set x 0;  set anchor n  }
        right  { set relx 1.0; set x -5; set anchor ne }
    }
    set bd [Widget::getoption $path -borderwidth]
    switch [Widget::getoption $path -baseline] {
        top    {
	    set y    0
	    set htop $height
	    set hbot 1
	}
        center {
	    set y    0
	    set htop [expr {$height/2}]
	    set hbot [expr {$height/2+$height%2+1}]
	}
        bottom {
	    set y    [expr {$bd+1}]
	    set htop 1
	    set hbot $height
	}
    }
    $padtop configure -height $htop
    $padbot configure -height $hbot

    set pad [Widget::getoption $path -ipad]
    pack $padbot -side top -fill x
    pack $frame  -in $border -fill both -expand yes -padx $pad -pady $pad

    pack $padtop -side top -fill x
    pack $border -fill both -expand yes

    place $label -relx $relx -x $x -anchor $anchor -y $y

    bind $label <Configure> [list TitleFrame::_place $path]
    bind $path  <Destroy>   [list Widget::destroy %W]

    return [Widget::create TitleFrame $path]
}


# ------------------------------------------------------------------------------
#  Command TitleFrame::configure
# ------------------------------------------------------------------------------
proc TitleFrame::configure { path args } {
    set res [Widget::configure $path $args]

    if { [Widget::hasChanged $path -ipad pad] } {
        pack configure $path.f -padx $pad -pady $pad
    }
    if { [Widget::hasChanged $path -borderwidth val] |
         [Widget::hasChanged $path -font        val] |
         [Widget::hasChanged $path -side        val] |
         [Widget::hasChanged $path -baseline    val] } {
        _place $path
    }

    return $res
}


# ------------------------------------------------------------------------------
#  Command TitleFrame::cget
# ------------------------------------------------------------------------------
proc TitleFrame::cget { path option } {
    return [Widget::cget $path $option]
}


# ------------------------------------------------------------------------------
#  Command TitleFrame::getframe
# ------------------------------------------------------------------------------
proc TitleFrame::getframe { path } {
    return $path.f
}


# ------------------------------------------------------------------------------
#  Command TitleFrame::_place
# ------------------------------------------------------------------------------
proc TitleFrame::_place { path } {
    set height [winfo height $path.l]
    switch [Widget::getoption $path -side] {
        left    { set relx 0.0; set x 10;  set anchor nw }
        center  { set relx 0.5; set x 0;   set anchor n  }
        right   { set relx 1.0; set x -10; set anchor ne }
    }
    set bd [Widget::getoption $path -borderwidth]
    switch [Widget::getoption $path -baseline] {
        top    { set htop $height; set hbot 1; set y 0 }
        center { set htop [expr {$height/2}]; set hbot [expr {$height/2+$height%2+1}]; set y 0 }
        bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] }
    }
    $path.p   configure -height $htop
    $path.b.p configure -height $hbot

    place $path.l -relx $relx -x $x -anchor $anchor -y $y
}
User Comments: oehhar added on 2016-10-31 14:51:00:

Thank you for the RFE to make TitleFrame themed-aware. IMHO one should use the native ttk::labelframe here.

Nevertheless, the patch is now in branch [rfe-4b6a27c9b8] (commit [28163b48cb]). It has the following issue:

% ::Widget::theme 1
% TitleFrame .t
% .t configure
unknown option "-background"

Please provide a complete patch to be included.

Thank you, Harald


adrianmedranocalvo (claiming to be Adrián Medraño Calvo <[email protected]>) added on 2016-09-02 11:10:46:
I had a look at this.  This is a consequence of the fix for [845613e5590ae7cf].  Continuing discussion there.

Independent of that, the fix here might be needed (thanks Johann!).  I haven't yet had time to have a look.

oehhar added on 2016-08-29 08:35:58:

It is a following error. When just usin Label in a fresh environment, it works:

Widget::theme 1
Label .l -text A


oehhar added on 2016-08-29 07:09:59:

Thank you for the report.

Reproduction

As an intro, it is ok that the demo does not run in themed mode. It is not designed to run with it.

Now I try to understand what you mean with "the TitleFrame widget fails".

To reproduce the issue, I did:

Widget::theme 1
source demo.tcl

The resulting error message is:

expected integer but got ""
    while executing
"$tkwidget $widget"
    (procedure "_get_tkwidget_options" line 10)
    invoked from within
"_get_tkwidget_options $tkwidget"
    (procedure "Widget::declare" line 69)
    invoked from within
"Widget::declare ButtonBox {
	{-background  TkResource ""	    0 frame}
	{-orient      Enum	 horizontal 1 {horizontal vertical}}
	{-state	      Enum	 "n..."
    (in namespace eval "::ButtonBox" script line 4)
    invoked from within
"namespace eval ButtonBox {
    Widget::define ButtonBox buttonbox Button

    Widget::declare ButtonBox {
	{-background  TkResource ""	    0 frame}
	{..."
    (file "checkout_bwidget/buttonbox.tcl" line 18)
    invoked from within
"source checkout_bwidget/buttonbox.tcl"
    (in namespace eval "::" script line 1)
    invoked from within
"namespace eval :: $auto_index($name)"
    (procedure "auto_load" line 13)
    invoked from within
"auto_load $name [uplevel 1 {::namespace current}]"
    (autoloading "ButtonBox::use")
    (procedure "::unknown" line 30)
    invoked from within
"${dep}::use"
    (procedure "Widget::define" line 45)
    invoked from within
"Widget::define Dialog dialog ButtonBox"
    (in namespace eval "::Dialog" script line 2)
    invoked from within
"namespace eval Dialog {
    Widget::define Dialog dialog ButtonBox

    Widget::bwinclude Dialog ButtonBox .bbox \
	remove	   {-orient} \
	initialize ..."
    (file "checkout_bwidget/dialog.tcl" line 24)
    invoked from within
"source checkout_bwidget/dialog.tcl"
    (in namespace eval "::" script line 1)
    invoked from within
"namespace eval :: $auto_index($name)"
    (procedure "auto_load" line 13)
    invoked from within
"auto_load $name [uplevel 1 {::namespace current}]"
    (autoloading "Dialog::use")
    (procedure "::unknown" line 30)
    invoked from within
"${dep}::use"
    (procedure "Widget::define" line 45)
    invoked from within
"Widget::define SelectFont font Dialog LabelFrame ScrolledWindow"
    (in namespace eval "::SelectFont" script line 2)
    invoked from within
"namespace eval SelectFont {
    Widget::define SelectFont font Dialog LabelFrame ScrolledWindow

    Widget::declare SelectFont {
        {-title		Str..."
    (file "checkout_bwidget/font.tcl" line 17)
    invoked from within
"source checkout_bwidget/font.tcl"
    (in namespace eval "::" script line 1)
    invoked from within
"namespace eval :: $auto_index($name)"
    (procedure "auto_load" line 13)
    invoked from within
"auto_load $name [uplevel 1 {::namespace current}]"
    (autoloading "SelectFont::loadfont")
    (procedure "::unknown" line 30)
    invoked from within
"SelectFont::loadfont"
    (procedure "Demo::create" line 14)
    invoked from within
"Demo::create"
    (procedure "Demo::main" line 12)
    invoked from within
"Demo::main"
    (file "U:\elmicron\tech\tcl\bwidget\checkout_bwidget\demo\demo.tcl" line 211)
    invoked from within
"source {U:\elmicron\tech\tcl\bwidget\checkout_bwidget\demo\demo.tcl}"

So the button box is the (first) issue when running the demo (unadequatly) in tile mode.

ButtonBox

This leads to the test sequence:

bwidget) 1 % Widget::theme 1
1
(bwidget) 2 % ButtonBox .b
expected integer but got ""
(bwidget) 3 % set errorInfo
expected integer but got ""
    while executing
"$tkwidget $widget"
    (procedure "_get_tkwidget_options" line 10)
    invoked from within
"_get_tkwidget_options $tkwidget"
    (procedure "Widget::declare" line 69)
    invoked from within
"Widget::declare ButtonBox {
	{-background  TkResource ""	    0 frame}
	{-orient      Enum	 horizontal 1 {horizontal vertical}}
	{-state	      Enum	 "n..."
    (in namespace eval "::ButtonBox" script line 4)
    invoked from within
"namespace eval ButtonBox {
    Widget::define ButtonBox buttonbox Button

    Widget::declare ButtonBox {
	{-background  TkResource ""	    0 frame}
	{..."
    (file "checkout_bwidget/buttonbox.tcl" line 18)
    invoked from within
"source checkout_bwidget/buttonbox.tcl"
    (in namespace eval "::" script line 1)
    invoked from within
"namespace eval :: $auto_index($name)"
    (procedure "auto_load" line 13)
    invoked from within
"auto_load $name [uplevel 1 {::namespace current}]"
    (autoloading "ButtonBox")
    (procedure "::unknown" line 30)
    invoked from within
"ButtonBox .b"

TitleFrame

Then I tried TitleFrame:

TitleFrame .t -text A
pack .t
this works.

Label

Nevertheless:

Label .l -text A
expected integer but got ""
    while executing
"$tkwidget $widget"
    (procedure "_get_tkwidget_options" line 10)
    invoked from within
"_get_tkwidget_options $tkwidget"
    (procedure "Widget::declare" line 69)
    invoked from within
"Widget::declare Label {
        {-name               String     ""     0}
        {-text               String     ""     0}
        {-textvariable    ..."
    (in namespace eval "::Label" script line 10)
    invoked from within
"namespace eval Label {
    Widget::define Label label DragSite DropSite DynamicHelp

    if {$::Widget::_theme} {
        Widget::tkinclude Label labe..."
    (file "checkout_bwidget/label.tcl" line 16)
    invoked from within
"source checkout_bwidget/label.tcl"
    (in namespace eval "::" script line 1)
    invoked from within
"namespace eval :: $auto_index($name)"
    (procedure "auto_load" line 13)
    invoked from within
"auto_load $name [uplevel 1 {::namespace current}]"
    (autoloading "::Label::create")
    (procedure "::unknown" line 30)
    invoked from within

So I suppose, we have killed something in recent commits. As far as I remember, this worked before..

Thank you, Harald