/usr/share/doc/bwidget/examples/basic.tcl is in bwidget 1.9.10-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | namespace eval DemoBasic {
variable var
variable count 0
variable id ""
}
proc DemoBasic::create { nb } {
set frame [$nb insert end demoBasic -text "Basic"]
set topf [frame $frame.topf]
set titf1 [TitleFrame $topf.titf1 -text "Label"]
set titf2 [TitleFrame $topf.titf2 -text "Entry"]
set titf3 [TitleFrame $frame.titf3 -text "Button and ArrowButton"]
_label [$titf1 getframe]
_entry [$titf2 getframe]
_button [$titf3 getframe]
pack $titf1 $titf2 -side left -fill both -padx 4 -expand yes
pack $topf -pady 2 -fill x
pack $titf3 -pady 2 -padx 4 -fill x
return $frame
}
proc DemoBasic::_label { parent } {
variable var
set lab [Label $parent.label -text "This is a Label widget" \
-helptext "Label widget"]
set chk [checkbutton $parent.chk -text "Disabled" \
-variable DemoBasic::var($lab,-state) \
-onvalue disabled -offvalue normal \
-command "$lab configure -state \$DemoBasic::var($lab,-state)"]
pack $lab -anchor w -pady 4
pack $chk -anchor w
}
proc DemoBasic::_entry { parent } {
set ent [Entry $parent.entry -text "Press enter" \
-command {set DemoBasic::var(entcmd) "-command called" ; after 500 {set DemoBasic::var(entcmd) ""}} \
-helptext "Entry widget"]
set chk1 [checkbutton $parent.chk1 -text "Disabled" \
-variable DemoBasic::var($ent,state) \
-onvalue disabled -offvalue normal \
-command "$ent configure -state \$DemoBasic::var($ent,state)"]
set chk2 [checkbutton $parent.chk2 -text "Non editable" \
-variable DemoBasic::var($ent,editable) \
-onvalue false -offvalue true \
-command "$ent configure -editable \$DemoBasic::var($ent,editable)"]
set lab [label $parent.cmd -textvariable DemoBasic::var(entcmd) -foreground red]
pack $ent -pady 4 -anchor w
pack $chk1 $chk2 -anchor w
pack $lab -pady 4
}
proc DemoBasic::_button { parent } {
variable var
set frame [frame $parent.butfr]
set but [Button $frame.but -text "Press me!" \
-repeatdelay 300 \
-command "DemoBasic::_butcmd command" \
-helptext "This is a Button widget"]
set sep1 [Separator $frame.sep1 -orient vertical]
set arr1 [ArrowButton $frame.arr1 -type button \
-width 25 -height 25 \
-repeatdelay 300 \
-command "DemoBasic::_butcmd command" \
-helptext "This is an ArrowButton widget\nof type button"]
set sep2 [Separator $frame.sep2 -orient vertical]
set arr2 [ArrowButton $frame.arr2 -type arrow \
-width 25 -height 25 -relief sunken -ipadx 0 -ipady 0 \
-repeatdelay 300 \
-command "DemoBasic::_butcmd command" \
-helptext "This is an ArrowButton widget\nof type arrow"]
pack $but -side left -padx 4
pack $sep1 -side left -padx 4 -fill y
pack $arr1 -side left -padx 4
pack $sep2 -side left -padx 4 -fill y
pack $arr2 -side left -padx 4
pack $frame
set sep3 [Separator $parent.sep3 -orient horizontal]
pack $sep3 -fill x -pady 10
set labf1 [LabelFrame $parent.labf1 -text "Command" -side top \
-anchor w -relief sunken -borderwidth 1]
set subf [$labf1 getframe]
set chk1 [checkbutton $subf.chk1 -text "Disabled" \
-variable DemoBasic::var(bstate) -onvalue disabled -offvalue normal \
-command "DemoBasic::_bstate \$DemoBasic::var(bstate) $but $arr1 $arr2"]
set chk2 [checkbutton $subf.chk2 -text "Use -armcommand/\n-disarmcommand" \
-justify left \
-variable DemoBasic::var(barmcmd) \
-command "DemoBasic::_barmcmd \$DemoBasic::var(barmcmd) $but $arr1 $arr2"]
pack $chk1 $chk2 -anchor w
set label [label $parent.label -textvariable DemoBasic::var(butcmd) -foreground red]
pack $label -side bottom -pady 4
set labf2 [LabelFrame $parent.labf2 -text "Direction" -side top \
-anchor w -relief sunken -borderwidth 1]
set subf [$labf2 getframe]
set var(bside) top
foreach dir {top left bottom right} {
set rad [radiobutton $subf.$dir -text "$dir arrow" \
-variable DemoBasic::var(bside) -value $dir \
-command "DemoBasic::_bside \$DemoBasic::var(bside) $arr1 $arr2"]
pack $rad -anchor w
}
set labf3 [LabelFrame $parent.labf3 -text "Relief" -side top \
-anchor w -relief sunken -borderwidth 1]
set subf [$labf3 getframe]
set var(brelief) raised
foreach {f lrelief} {f1 {raised sunken ridge groove} f2 {flat solid link}} {
set f [frame $subf.$f]
foreach relief $lrelief {
set rad [radiobutton $f.$relief -text $relief \
-variable DemoBasic::var(brelief) -value $relief \
-command "DemoBasic::_brelief \$DemoBasic::var(brelief) $but $arr1 $arr2"]
pack $rad -anchor w
}
pack $f -side left -padx 2 -anchor n
}
pack $labf1 $labf2 $labf3 -side left -fill y -padx 4
}
proc DemoBasic::_bstate { state but arr1 arr2 } {
foreach but [list $but $arr1 $arr2] {
$but configure -state $state
}
}
proc DemoBasic::_brelief { relief but arr1 arr2 } {
$but configure -relief $relief
if { $relief != "link" } {
foreach arr [list $arr1 $arr2] {
$arr configure -relief $relief
}
}
}
proc DemoBasic::_bside { side args } {
foreach arr $args {
$arr configure -dir $side
}
}
proc DemoBasic::_barmcmd { value but arr1 arr2 } {
if { $value } {
$but configure \
-armcommand "DemoBasic::_butcmd arm" \
-disarmcommand "DemoBasic::_butcmd disarm" \
-command {}
foreach arr [list $arr1 $arr2] {
$arr configure \
-armcommand "DemoBasic::_butcmd arm" \
-disarmcommand "DemoBasic::_butcmd disarm" \
-command {}
}
} else {
$but configure -armcommand {} -disarmcommand {} \
-command "DemoBasic::_butcmd command"
foreach arr [list $arr1 $arr2] {
$arr configure -armcommand {} -disarmcommand {} \
-command "DemoBasic::_butcmd command"
}
}
}
proc DemoBasic::_butcmd { reason } {
variable count
variable id
catch {after cancel $id}
if { $reason == "arm" } {
incr count
set DemoBasic::var(butcmd) "$reason command called ($count)"
} else {
set count 0
set DemoBasic::var(butcmd) "$reason command called"
}
set id [after 500 {set DemoBasic::var(butcmd) ""}]
}
|