Bwidget Source Code
Check-in [affe6554cd]
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.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:* notebook.tcl: Changed appearance of tabs; leftmost tab is now flush with the left of the notebook, and the tabs look more Windows-like.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: affe6554cd86f6509514bcfe898df2aafda3f41e
User & Date: ericm 2000-02-17 03:06:01
Context
2000-02-17
18:37
* notebook.tcl: Added an extra check to move the leftmost tab a touch to the right when it is not selected (again, to make the tabs more Windows-like). Also replaced redundant [string equal] checks with a stored pre-check (ie, set foo [string equal ...]). check-in: 4f04c7bef8 user: ericm tags: trunk
03:06
* notebook.tcl: Changed appearance of tabs; leftmost tab is now flush with the left of the notebook, and the tabs look more Windows-like. check-in: affe6554cd user: ericm tags: trunk
2000-02-16
20:19
*** empty log message *** check-in: d5371a4cad user: sven tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to notebook.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
504
505
506
507
508
509
510

511



512


513
514
515
516
517
518
519
...
537
538
539
540
541
542
543
544

545
546
547
548
549
550
551
...
674
675
676
677
678
679
680





681
682
683





























684
685
686
687
688






689
690
691
692








693






694
695
696




697






698
699

700
701
702
703
704
705






706
707







708
709
710
711


712
713


714
715

716


717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745

746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
...
771
772
773
774
775
776
777

778
779
780
781
782
783
784
...
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
# ------------------------------------------------------------------------------
#  notebook.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: notebook.tcl,v 1.4 2000/02/11 22:54:27 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - NoteBook::create
#     - NoteBook::configure
#     - NoteBook::cget
#     - NoteBook::compute_size
#     - NoteBook::insert
................................................................................
    set wtot 0
    if { ![info exists data(textid)] } {
        set data(textid) [$path:cmd create text 0 -100 -font [Widget::getoption $path -font] -anchor nw]
    }
    set id $data(textid)
    $path:cmd itemconfigure $id -font [Widget::getoption $path -font]
    foreach page $data(pages) {

        $path:cmd itemconfigure $id -text [Widget::getoption $path.f$page -text]



        set  wtext [expr {[lindex [$path:cmd bbox $id] 2]+20}]


        if { [set img [Widget::getoption $path.f$page -image]] != "" } {
            set wtext [expr {$wtext+[image width $img]+4}]
            set himg  [expr {[image height $img]+6}]
            if { $himg > $hmax } {
                set hmax $himg
            }
        }
................................................................................
# ------------------------------------------------------------------------------
proc NoteBook::_get_x_page { path pos } {
    variable _warrow
    variable $path
    upvar 0  $path data

    set base $data(base)
    set x    [expr {$_warrow+1}]

    if { $pos < $base } {
        foreach page [lrange $data(pages) $pos [expr {$base-1}]] {
            incr x [expr {-$data($page,width)}]
        }
    } elseif { $pos > $base } {
        foreach page [lrange $data(pages) $base [expr {$pos-1}]] {
            incr x $data($page,width)
................................................................................
proc NoteBook::_draw_page { path page create } {
    variable $path
    upvar 0  $path data

    # --- calcul des coordonnees et des couleurs de l'onglet ------------------
    set pos [lsearch $data(pages) $page]
    set bg  [_getoption $path $page -background]





    set h   $data(hpage)
    set xd  [_get_x_page $path $pos]
    set xf  [expr {$xd + $data($page,width)}]





























    # Sven
    set side [Widget::getoption $path -side]
    set h1 [expr {[winfo height $path]}]
    set bd [Widget::getoption $path -borderwidth]
    if {"$side" == "bottom"} {






        set lt  [list $xd [expr {$h1-$h-1}] $xd [expr {$h1-4}] \
            [expr {$xd+3}] [expr {$h1-1}]]
        set lb  [list [expr {$xd+3}] [expr {$h1-1}] $xf [expr {$h1-1}] \
            [expr {$xf+3}] [expr {$h1-4}] [expr {$xf+3}] [expr {$h1-$h+3}] \








            [expr {$xf+6}] [expr {$h1-$h-1}]]






    } else {
        set lt  [list $xd $h $xd 4 [expr {$xd+3}] 1 $xf 1]
        set lb  [list $xf 1 [expr {$xf+3}] 4 [expr {$xf+3}] [expr {$h-3}] \




            [expr {$xf+6}] $h]






    }
    # Sven end

    set img [Widget::getoption $path.f$page -image]
    if { $data(select) == $page } {
        set fgt   $data(lbg)
        set fgb   $data(dbg)
        # Sven
        if {"$side" == "bottom"} {






            set ytext [expr {($h1 - ($h/2))}]
        } else {







            set ytext [expr {$h/2-1}]
        }
        # Sven end
        if { $img == "" } {


            set xtext [expr {$xd+9}]
        } else {


            set ximg  [expr {$xd+9}]
            set xtext [expr {$ximg+[image width $img]+4}]

        }


        set bd    [Widget::getoption $path -borderwidth]
        set fg    [_getoption $path $page -foreground]
    } else {
        set fgt   $data(dbg)
        set fgb   $fgt
        # Sven
        if {"$side" == "bottom"} {
            set ytext [expr {$h1 - ($h/2) - 1}]
        } else {
            set ytext [expr {$h/2}]
        }
        # Sven end
        if { $img == "" } {
            set xtext [expr {$xd+10}]
        } else {
            set ximg  [expr {$xd+10}]
            set xtext [expr {$ximg+[image width $img]+4}]
        }
        set bd    1
        if { [Widget::getoption $path.f$page -state] == "normal" } {
            set fg [_getoption $path $page -foreground]
        } else {
            set fg [_getoption $path $page -disabledforeground]
        }
    }

    # --- creation ou modification de l'onglet --------------------------------
    # Sven
    if { $create } {

        eval $path:cmd create polygon [concat $lt $lb]		\
		-tag		{"page p:$page $page:poly"}	\
		-outline	$bg				\
		-fill		$bg
        eval $path:cmd create line $lt \
            -tags {"page p:$page $page:top top"} -fill $fgt -width $bd
        eval $path:cmd create line $lb \
            -tags {"page p:$page $page:bot bot"} -fill $fgb -width $bd
        $path:cmd create text $xtext $ytext           \
            -text   [Widget::getoption $path.f$page -text] \
            -font   [Widget::getoption $path -font]        \
            -fill   $fg                               \
            -anchor w                                 \
            -tags   "page p:$page $page:text"

        $path:cmd bind p:$page <ButtonPress-1> "NoteBook::_select $path $page"
        $path:cmd bind p:$page <Enter>         "NoteBook::_highlight on  $path $page"
        $path:cmd bind p:$page <Leave>         "NoteBook::_highlight off $path $page"
    } else {
        $path:cmd coords "$page:text" $xtext $ytext

................................................................................
    }
    eval $path:cmd coords "$page:poly" [concat $lt $lb]
    eval $path:cmd coords "$page:top"  $lt
    eval $path:cmd coords "$page:bot"  $lb
    $path:cmd itemconfigure "$page:poly" -fill $bg  -outline $bg
    $path:cmd itemconfigure "$page:top"  -fill $fgt -width $bd
    $path:cmd itemconfigure "$page:bot"  -fill $fgb -width $bd

    # Sven end
        
    if { $img != "" } {
        # Sven
	set id [$path:cmd find withtag $page:img]
	if { [string equal $id ""] } {
	    set id [$path:cmd create image $ximg $ytext \
................................................................................
    set sel $data(select)
    if {  $sel == "" } {
        set xd  [expr {$w/2}]
        set xf  $xd
        set lbg $data(dbg)
    } else {
        set xd [_get_x_page $path [lsearch $data(pages) $data(select)]]
        set xf [expr {$xd + $data($sel,width)+6}]
        set lbg $data(lbg)
    }

    # Sven
    if { [llength [$path:cmd find withtag rect]] == 0} {
        $path:cmd create line $xd $y0 $x0 $y0 $x0 $y1 \
            -tags "rect toprect1" 


|







 







>
|
>
>
>
|
>
>







 







|
>







 







>
>
>
>
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




<
>
>
>
>
>
>
|
<
<
<
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>

<
<
>
>
>
>
|
>
>
>
>
>
>

<
>

<
<
<
<
<
>
>
>
>
>
>
|
<
>
>
>
>
>
>
>
|
|
<
<
>
>
|
<
>
>
|
<
>
|
>
>



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<











>








|
|
|
|
|
|







 







>







 







|







1
2
3
4
5
6
7
8
9
10
11
...
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
...
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
...
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728

729
730
731
732
733
734
735



736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751


752
753
754
755
756
757
758
759
760
761
762
763

764
765





766
767
768
769
770
771
772

773
774
775
776
777
778
779
780
781


782
783
784

785
786
787

788
789
790
791
792
793
794















795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
...
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
...
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
# ------------------------------------------------------------------------------
#  notebook.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: notebook.tcl,v 1.5 2000/02/17 03:06:01 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - NoteBook::create
#     - NoteBook::configure
#     - NoteBook::cget
#     - NoteBook::compute_size
#     - NoteBook::insert
................................................................................
    set wtot 0
    if { ![info exists data(textid)] } {
        set data(textid) [$path:cmd create text 0 -100 -font [Widget::getoption $path -font] -anchor nw]
    }
    set id $data(textid)
    $path:cmd itemconfigure $id -font [Widget::getoption $path -font]
    foreach page $data(pages) {
        $path:cmd itemconfigure $id -text \
		[Widget::getoption $path.f$page -text]
	# Get the bbox for this text to determine its width, then substract
	# 6 from the width to account for canvas bbox oddness w.r.t. widths of
	# simple text.
	foreach {x1 y1 x2 y2} [$path:cmd bbox $id] break
	set x2 [expr {$x2 - 6}]
        set  wtext [expr {$x2 - $x1 + 20}]
        if { [set img [Widget::getoption $path.f$page -image]] != "" } {
            set wtext [expr {$wtext+[image width $img]+4}]
            set himg  [expr {[image height $img]+6}]
            if { $himg > $hmax } {
                set hmax $himg
            }
        }
................................................................................
# ------------------------------------------------------------------------------
proc NoteBook::_get_x_page { path pos } {
    variable _warrow
    variable $path
    upvar 0  $path data

    set base $data(base)
    # notebook tabs start flush with the left side of the notebook
    set x 0
    if { $pos < $base } {
        foreach page [lrange $data(pages) $pos [expr {$base-1}]] {
            incr x [expr {-$data($page,width)}]
        }
    } elseif { $pos > $base } {
        foreach page [lrange $data(pages) $base [expr {$pos-1}]] {
            incr x $data($page,width)
................................................................................
proc NoteBook::_draw_page { path page create } {
    variable $path
    upvar 0  $path data

    # --- calcul des coordonnees et des couleurs de l'onglet ------------------
    set pos [lsearch $data(pages) $page]
    set bg  [_getoption $path $page -background]

    # lookup the tab colors
    set fgt   $data(lbg)
    set fgb   $data(dbg)

    set h   $data(hpage)
    set xd  [_get_x_page $path $pos]
    set xf  [expr {$xd + $data($page,width)}]

    # Coordinates of the tab corners are:
    #     c3        c4
    #
    # c2                c5
    #
    # c1                c6
    #
    # where
    # c1 = $xd,	  $h
    # c2 = $xd,	  4
    # c3 = $xd+2, 2
    # c4 = $xf+1, 2
    # c5 = $xf+2, 4
    # c6 = $xf+2, $h

    set top		2
    set arcRadius	2

    if { $data(select) != $page } {
	# Non-selected pages have tabs 2 pixels lower than the selected one
	incr top 2
    }

    # Precompute some coord values that we use a lot
    set topPlusRadius	[expr {$top + $arcRadius}]
    set rightPlusRadius	[expr {$xf + $arcRadius}]
    set leftPlusRadius	[expr {$xd + $arcRadius}]

    # Sven
    set side [Widget::getoption $path -side]
    set h1 [expr {[winfo height $path]}]
    set bd [Widget::getoption $path -borderwidth]

    if { [string equal $side "bottom"] } {
	set top [expr {$top * -1}]
	set topPlusRadius [expr {$topPlusRadius * -1}]
	# Hrm... the canvas has an issue with drawing diagonal segments
	# of lines from the bottom to the top, so we have to draw this line
	# backwards (ie, lt is actually the bottom, drawn from right to left)
        set lt  [list 					\



		$rightPlusRadius	[expr {$h1-$h-1}]		\
		$rightPlusRadius	[expr {$h1 + $topPlusRadius}]	\
		$xf			[expr {$h1 + $top}]		\
		$leftPlusRadius		[expr {$h1 + $top}]		\
		]
        set lb  [list					\
		$leftPlusRadius		[expr {$h1 + $top}]		\
		$xd			[expr {$h1 + $topPlusRadius}] \
		$xd			[expr {$h1-$h-1}]	\
		]
	# Because we have to do this funky reverse order thing, we have to
	# swap the top/bottom colors too.
	set tmp $fgt
	set fgt $fgb
	set fgb $tmp
    } else {


	set lt [list					\
		$xd			$h		\
		$xd			$topPlusRadius	\
		$leftPlusRadius		$top		\
		[expr {$xf + 1}]	$top		\
		]
	set lb [list 						\
		[expr {$xf + 1}] 	[expr {$top + 1}]	\
		$rightPlusRadius	$topPlusRadius		\
		$rightPlusRadius	$h			\
		]
    }


    set img [Widget::getoption $path.f$page -image]






    # Text on the tab is down a few pixels from the top of the tab, and
    # centered left-to-right.
    set textOffsetY 3
    set textOffsetX 9

    set ytext $top

    if { [string equal $side "bottom"] } {
	# The "+ 2" below moves the text closer to the bottom of the tab,
	# so it doesn't look so cramped.  I should be able to achieve the
	# same goal by changing the anchor of the text and using this formula:
	# ytext = $top + $h1 - $textOffsetY
	# but that doesn't quite work (I think the linespace from the text
	# gets in the way)
	incr ytext [expr {$h1 - $h + 2}]
    }


    incr ytext $textOffsetY

    set xtext [expr {$xd + $textOffsetX}]

    if { $img != "" } {
	# if there's an image, put it on the left and move the text right
	set ximg $xtext

	incr ximg [expr {[image width $img] + 4}]
    }
	
    if { $data(select) == $page } {
        set bd    [Widget::getoption $path -borderwidth]
        set fg    [_getoption $path $page -foreground]
    } else {















        set bd    1
        if { [Widget::getoption $path.f$page -state] == "normal" } {
            set fg [_getoption $path $page -foreground]
        } else {
            set fg [_getoption $path $page -disabledforeground]
        }
    }

    # --- creation ou modification de l'onglet --------------------------------
    # Sven
    if { $create } {
	# Create the tab region
        eval $path:cmd create polygon [concat $lt $lb]		\
		-tag		{"page p:$page $page:poly"}	\
		-outline	$bg				\
		-fill		$bg
        eval $path:cmd create line $lt \
            -tags {"page p:$page $page:top top"} -fill $fgt -width $bd
        eval $path:cmd create line $lb \
            -tags {"page p:$page $page:bot bot"} -fill $fgb -width $bd
        $path:cmd create text $xtext $ytext 			\
		-text	[Widget::getoption $path.f$page -text]	\
		-font	[Widget::getoption $path -font]		\
		-fill	$fg					\
		-anchor	nw					\
		-tags	"page p:$page $page:text"

        $path:cmd bind p:$page <ButtonPress-1> "NoteBook::_select $path $page"
        $path:cmd bind p:$page <Enter>         "NoteBook::_highlight on  $path $page"
        $path:cmd bind p:$page <Leave>         "NoteBook::_highlight off $path $page"
    } else {
        $path:cmd coords "$page:text" $xtext $ytext

................................................................................
    }
    eval $path:cmd coords "$page:poly" [concat $lt $lb]
    eval $path:cmd coords "$page:top"  $lt
    eval $path:cmd coords "$page:bot"  $lb
    $path:cmd itemconfigure "$page:poly" -fill $bg  -outline $bg
    $path:cmd itemconfigure "$page:top"  -fill $fgt -width $bd
    $path:cmd itemconfigure "$page:bot"  -fill $fgb -width $bd
    
    # Sven end
        
    if { $img != "" } {
        # Sven
	set id [$path:cmd find withtag $page:img]
	if { [string equal $id ""] } {
	    set id [$path:cmd create image $ximg $ytext \
................................................................................
    set sel $data(select)
    if {  $sel == "" } {
        set xd  [expr {$w/2}]
        set xf  $xd
        set lbg $data(dbg)
    } else {
        set xd [_get_x_page $path [lsearch $data(pages) $data(select)]]
        set xf [expr {$xd + $data($sel,width) + 3}]
        set lbg $data(lbg)
    }

    # Sven
    if { [llength [$path:cmd find withtag rect]] == 0} {
        $path:cmd create line $xd $y0 $x0 $y0 $x0 $y1 \
            -tags "rect toprect1"