File: NoteBook.tcl

package info (click to toggle)
tix 8.4.3-14
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 9,316 kB
  • sloc: ansic: 28,084; tcl: 22,774; python: 7,577; makefile: 333; cs: 253; sh: 210; perl: 128
file content (64 lines) | stat: -rw-r--r-- 1,554 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
#	$Id: NoteBook.tcl,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
#
proc About {} {
    return "Testing the notebook widgets"
}

proc NoteBookPageConfig {w pages} {
    foreach page $pages {
	Assert {"x[$w pagecget $page -label]" == "x$page"}
	Assert {"x[$w pageconfigure $page -label]" == "x-label {} {} {} $page"}
	$w pageconfigure $page -label foo
	Assert {"x[$w pagecget $page -label]" == "xfoo"}
	update
    }
}

proc Test {} {
    foreach class {tixListNoteBook tixNoteBook tixStackWindow} {
	set w [$class .d]
	pack $w
	update

	set pages {1 2 3 4 5 6 1111111112221}

	foreach page $pages {
	    if {$class == "tixListNoteBook"} {
		$w subwidget hlist add $page -itemtype imagetext \
		    -image [tix getimage folder] -text $page
	    }
	    set p [$w add $page -label $page]
	    for {set x 1} {$x < 10} {incr x} {
		button $p.$x -text $x
		pack $p.$x -fill x
	    }
	}

	foreach page $pages {
	    $w raise $page
	    Assert {"x[$w raised]" == "x$page"}
	    update
	}

	Assert {[string compare $pages [$w pages]] == 0}

	# test the "hooking" of the notebook frame subwidget
	#
	#
	if {$class == "tixNoteBook"} {
	    NoteBookPageConfig $w $pages
	}

	foreach page $pages {
	    Assert {"x[$w pagecget $page -raisecmd]" == "x"}
#	    Assert {"x[$w pageconfigure $page -raisecmd]" == "x-raisecmd {} {} {} {}"}
	    $w pageconfigure $page -raisecmd "RaiseCmd $page"
	    Assert {"x[$w pagecget $page -raisecmd]" == "xRaiseCmd $page"}
	    update
	}

	destroy $w
    }
}