This file is indexed.

/usr/share/blt2.5/demos/busy2.tcl is in blt-demo 2.5.3+dfsg-1.

This file is owned by root:root, with mode 0o755.

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
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
#!/usr/bin/wish8.6

package require BLT
# --------------------------------------------------------------------------
# Starting with Tcl 8.x, the BLT commands are stored in their own 
# namespace called "blt".  The idea is to prevent name clashes with
# Tcl commands and variables from other packages, such as a "table"
# command in two different packages.  
#
# You can access the BLT commands in a couple of ways.  You can prefix
# all the BLT commands with the namespace qualifier "blt::"
#  
#    blt::graph .g
#    blt::table . .g -fill both
# 
# or you can import all the command into the global namespace.
#
#    namespace import blt::*
#    graph .g
#    table . .g -fill both
#
# --------------------------------------------------------------------------

if { $tcl_version >= 8.0 } {
    namespace import blt::*
#    namespace import -force blt::tile::*
}
#source scripts/demo.tcl

#
# Script to test the "busy" command.
# 

#
# General widget class resource attributes
#
option add *Button.padX 	10
option add *Button.padY 	2
option add *Scale.relief 	sunken
#option add *Scale.orient	horizontal
option add *Entry.relief 	sunken
option add *Frame.borderWidth 	2

set visual [winfo screenvisual .] 
if { $visual == "staticgray"  || $visual == "grayscale" } {
    set activeBg black
    set normalBg white
    set bitmapFg black
    set bitmapBg white
    option add *f1.background 		white
} else {
    set activeBg red
    set normalBg springgreen
    set bitmapFg blue
    set bitmapBg green
    option add *Button.background       khaki2
    option add *Button.activeBackground khaki1
    option add *Frame.background        khaki2
    option add *f2.tile		textureBg
#    option add *Button.tile		textureBg

    option add *releaseButton.background 		limegreen
    option add *releaseButton.activeBackground 	springgreen
    option add *releaseButton.foreground 		black

    option add *holdButton.background 		red
    option add *holdButton.activeBackground	pink
    option add *holdButton.foreground 		black
    option add *f1.background 		springgreen
}

#
# Instance specific widget options
#
option add *f1.relief 		sunken
option add *f1.background 	$normalBg
option add *testButton.text 	"Test"
option add *quitButton.text 	"Quit"
option add *newButton.text 	"New button"
option add *holdButton.text 	"Hold"
option add *releaseButton.text 	"Release"
option add *buttonLabel.text	"Buttons"
option add *entryLabel.text	"Entries"
option add *scaleLabel.text	"Scales"
option add *textLabel.text	"Text"

proc LoseFocus {} { 
    focus -force . 
}
proc KeepRaised { w } {
    bindtags $w keepRaised
}

bind keepRaised <Visibility> { raise %W } 

set file ./images/chalk.gif
image create photo textureBg -file $file

#
# This never gets used; it's reset by the Animate proc. It's 
# here to just demonstrate how to set busy window options via
# the host window path name
#
#option add *f1.busyCursor 	bogosity 


#
# Counter for new buttons created by the "New button" button
#
set numWin 0

menu .menu 
.menu add command -label "First"
.menu add command -label "Second"
.menu add command -label "Third"
.menu add command -label "Fourth"
. configure -menu .menu

#
# Create two frames. The top frame will be the host window for the
# busy window.  It'll contain widgets to test the effectiveness of
# the busy window.  The bottom frame will contain buttons to 
# control the testing.
#
frame .f1
frame .f2

#
# Create some widgets to test the busy window and its cursor
#
label .buttonLabel
button .testButton -command { 
    puts stdout "Not busy." 
}
button .quitButton -command { exit }
entry .entry 
scale .scale
text .text -width 20 -height 4

#
# The following buttons sit in the lower frame to control the demo
#
button .newButton -command {
    global numWin
    incr numWin
    set name button#${numWin}
    button .f1.$name -text "$name" \
	-command [list .f1 configure -bg blue]
    table .f1 \
	.f1.$name $numWin+3,0 -padx 10 -pady 10
}

button .holdButton -command {
    if { [busy isbusy .f1] == "" } {
        global activeBg
	.f1 configure -bg $activeBg
    }
    busy .f1 
    busy .#menu
    LoseFocus
}
button .releaseButton -command {
    if { [busy isbusy .f1] == ".f1" } {
        busy release .f1
        busy release .#menu
    }
    global normalBg
    .f1 configure -bg $normalBg
}

#
# Notice that the widgets packed in .f1 and .f2 are not their children
#
table .f1 \
    .testButton 0,0 \
    .scale 1,0 \
    .entry 0,1 \
    .text 1,1 -fill both \
    .quitButton 2,0 

table .f2 \
    .newButton 0,0 \
    .holdButton 1,0 \
    .releaseButton 2,0  

table configure .f1 .testButton .scale .entry .quitButton -padx 10 -pady 10 -fill both
table configure .f2 .newButton .holdButton .releaseButton -padx 10 -pady 10 
table configure .f2 c0 -resize none
#
# Finally, realize and map the top level window
#
table . \
    .f1 0,0  \
    .f2 1,0 

table configure . .f1 .f2 -fill both
# Initialize a list of bitmap file names which make up the animated 
# fish cursor. The bitmap mask files have a "m" appended to them.

table configure . r1 -resize none

set bitmapList { left left1 mid right1 right }

#
# Simple cursor animation routine: Uses the "after" command to 
# circulate through a list of cursors every 0.075 seconds. The
# first pass through the cursor list may appear sluggish because 
# the bitmaps have to be read from the disk.  Tk's cursor cache
# takes care of it afterwards.
#
proc StartAnimation { widget count } {
    global bitmapList
    set prefix "bitmaps/fish/[lindex $bitmapList $count]"
    set cursor [list @${prefix}.xbm ${prefix}m.xbm black white ]
    busy configure $widget -cursor $cursor

    incr count
    set limit [llength $bitmapList]
    if { $count >= $limit } {
	set count 0
    }
    global afterId
    set afterId($widget) [after 125 StartAnimation $widget $count]
}

proc StopAnimation { widget } {    
    global afterId
    after cancel $afterId($widget)
}

proc TranslateBusy { window } {
    #set widget [string trimright $window "_Busy"]
    set widget [string trimright $window "Busy"]
    set widget [string trimright $widget "_"]
#    if { [winfo toplevel $widget] != $widget } {
#        set widget [string trimright $widget "."]
#    }
    return $widget
}

if { [info exists tcl_platform] && $tcl_platform(platform) == "unix" } {
    bind Busy <Map> { 
	StartAnimation [TranslateBusy %W] 0
    }
    bind Busy <Unmap> { 
	StopAnimation  [TranslateBusy %W] 
    }
}

#
# For testing, allow the top level window to be resized 
#
wm min . 0 0

#
# Force the demo to stay raised
#
raise .
KeepRaised .