← Back to branch summary

~ubuntu-branches/ubuntu/breezy/kdemultimedia/breezy

« back to all changes in this revision

Viewing changes to kmidi/config/misc.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Jonathan Riddell
  • Date: 2005-03-24 04:48:58 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 sarge)
  • Revision ID: james.westby@ubuntu.com-20050324044858-8ff88o9jxej6ii3d
Tags: 4:3.4.0-0ubuntu3
Add kubuntu_02_hide_arts_menu_entries.diff to hide artsbuilder and artscontrol k-menu entries

Show diffs side-by-side

added added

removed removed

Lines of Context:
kmidi/config/misc.tcl
1
 
#----------------------------------------------------------------
2
 
# Miscellaneous procedures
3
 
# written by T.IWAI
4
 
#----------------------------------------------------------------
5
 
 
6
 
#----------------------------------------------------------------
7
 
# tk easy programming
8
 
#----------------------------------------------------------------
9
 
 
10
 
if [catch {expr $tk_priv(new_tcltk) == 0 || $tk_priv(new_tcltk) == 1}] {
11
 
    set tk_priv(new_tcltk) 0
12
 
    if [regexp "(\[0-9\]+\.\[0-9\]+)" $tk_patchLevel cur] {
13
 
        if {$cur >= 4.0} {
14
 
            set tk_priv(new_tcltk) 1
15
 
        }
16
 
    }
17
 
}
18
 
 
19
 
#
20
 
# get root file name
21
 
#
22
 
proc retrieve-filename {path} {
23
 
    set divs [split $path /]
24
 
    return [lindex $divs [expr [llength $divs] - 1]]
25
 
}
26
 
 
27
 
 
28
 
#
29
 
# sec to time string
30
 
#
31
 
proc sec2time {sec} {
32
 
    if {$sec >= 0} {
33
 
        return [format "%02d:%02d" [expr $sec / 60] [expr $sec % 60]]
34
 
    } else {
35
 
        set sec [expr -$sec]
36
 
        return [format "-%02d:%02d" [expr $sec / 60] [expr $sec % 60]]
37
 
    }
38
 
}
39
 
 
40
 
#
41
 
# numeric binding:
42
 
# only numerical key and some controls are available for input.
43
 
#
44
 
proc numeric-bind {w} {
45
 
    bind $w <Any-Key> {
46
 
        if {"%A" != "" && [regexp "\[0-9\]+" %A]} {
47
 
            %W insert insert %A
48
 
            tk_entrySeeCaret %W
49
 
        } elseif {"%K" == "Return"} {
50
 
            global tk_priv
51
 
            focus none
52
 
        }
53
 
    }
54
 
    bind $w <Key-Delete> {tk_entryBackspace %W; tk_entrySeeCaret %W}
55
 
    bind $w <Key-BackSpace> {tk_entryBackspace %W; tk_entrySeeCaret %W}
56
 
    bind $w <Control-Key-h> {tk_entryBackspace %W; tk_entrySeeCaret %W}
57
 
    bind $w <Control-Key-d> {%W delete sel.first sel.last; tk_entrySeeCaret %W}
58
 
    bind $w <Control-Key-u> {%W delete 0 end}
59
 
}
60
 
 
61
 
#
62
 
# make a listbox
63
 
#
64
 
proc my-listbox {w title size {dohoriz 1} {multiple 0}} {
65
 
    global tk_priv
66
 
    frame $w
67
 
    label $w.label -text $title -relief flat
68
 
    pack $w.label -side top -fill x -anchor w
69
 
    scrollbar $w.yscr -command "$w.list yview"
70
 
    pack $w.yscr -side right -fill y
71
 
    if {$tk_priv(new_tcltk)} {
72
 
        regexp "(\[0-9\]+)x(\[0-9\])" $size foo width height
73
 
        set lopt [list -width $width -height $height]
74
 
        if {$multiple} {
75
 
            lappend lopt -selectmode multiple
76
 
        }
77
 
    } else {
78
 
        set lopt [list -geometry $size]
79
 
    }
80
 
    if {$dohoriz} {
81
 
        scrollbar $w.xscr -command "$w.list xview" -orient horizontal
82
 
        pack $w.xscr -side bottom -fill x
83
 
        eval listbox $w.list -relief sunken -setgrid yes $lopt\
84
 
                [list -yscroll "$w.yscr set"]\
85
 
                [list -xscroll "$w.xscr set"]
86
 
    } else {
87
 
        eval listbox $w.list -relief sunken -setgrid yes $lopt\
88
 
            [list -yscroll "$w.yscr set"]
89
 
    }
90
 
    pack $w.list -side left -fill both -expand yes
91
 
    return $w.list
92
 
}
93
 
 
94
 
#----------------------------------------------------------------
95
 
# dialog pop-up
96
 
#----------------------------------------------------------------
97
 
 
98
 
proc my-dialog {w title defbtn canbtn buttons} {
99
 
    toplevel $w -class Dialog
100
 
    wm title $w $title
101
 
    wm iconname $w $title
102
 
 
103
 
    label $w.title -text $title -relief raised -bd 1
104
 
    pack $w.title -side top -fill x
105
 
    
106
 
    frame $w.f -relief raised -bd 1
107
 
    pack $w.f -side top -fill both
108
 
 
109
 
    frame $w.buttons -relief raised -bd 1
110
 
    pack $w.buttons -side bottom -fill both
111
 
    set i 0
112
 
    foreach but $buttons {
113
 
        button $w.buttons.c$i -text [lindex $but 0] -command [lindex $but 1]
114
 
        if {$defbtn != "" && $i == $defbtn} {
115
 
            frame $w.buttons.default -relief sunken -bd 1
116
 
            raise $w.buttons.c$i $w.buttons.default
117
 
            pack $w.buttons.default -side left -expand 1\
118
 
                    -padx 3m -pady 2m
119
 
            pack $w.buttons.c$i -in $w.buttons.default -padx 2m -pady 2m \
120
 
                    -ipadx 2m -ipady 1m
121
 
            bind $w <Return> "$w.buttons.c$i flash; $w.buttons.c$i invoke"
122
 
        } else {
123
 
            pack $w.buttons.c$i -side left -expand 1 \
124
 
                    -padx 3m -pady 3m -ipadx 2m -ipady 1m
125
 
            if {$canbtn != "" && $i == $canbtn} {
126
 
                bind $w <Key-Escape> "$w.buttons.c$i flash; $w.buttons.c$i invoke"
127
 
            }
128
 
        }
129
 
        incr i
130
 
    }
131
 
 
132
 
    return $w.f
133
 
}
134
 
 
135
 
#----------------------------------------------------------------
136
 
#  warning/question dialog
137
 
#----------------------------------------------------------------
138
 
 
139
 
if {$tk_priv(new_tcltk)} {
140
 
    proc my-message-dialog {w title text bitmap defbtn canbtn args} {
141
 
        #puts stderr $text
142
 
        return [eval tk_dialog [list $w $title $text $bitmap $defbtn] $args]
143
 
    }
144
 
} else {
145
 
    proc my-message-dialog {w title text bitmap defbtn canbtn args} {
146
 
        #puts stderr $text
147
 
        global tk_priv
148
 
        set butlist {}
149
 
        set num 0
150
 
        foreach i $args {
151
 
            lappend butlist [list $i "set tk_priv(button) $num; destroy $w"]
152
 
            incr num
153
 
        }
154
 
        set f [my-dialog $w $title $defbtn $canbtn $butlist]
155
 
        set num 0
156
 
        message $f.msg -width 3i -text $text
157
 
        pack $f.msg -side right -expand 1 -fill both -padx 5m -pady 5m
158
 
        if {$bitmap != ""} {
159
 
            label $f.bitmap -bitmap $bitmap
160
 
            pack $f.bitmap -side left -padx 5m -pady 5m
161
 
        }
162
 
        set tk_priv(button) 0
163
 
 
164
 
        wm withdraw $w
165
 
        update idletasks
166
 
        set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
167
 
                - [winfo vrootx [winfo parent $w]]]
168
 
        set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
169
 
                - [winfo vrooty [winfo parent $w]]]
170
 
        wm geom $w +$x+$y
171
 
        wm deiconify $w
172
 
 
173
 
        set oldFocus [focus]
174
 
        grab $w
175
 
        tkwait window $w
176
 
        focus $oldFocus
177
 
 
178
 
        return $tk_priv(button)
179
 
    }
180
 
}
181
 
 
182
 
proc warning {message} {
183
 
    my-message-dialog .warning "Warning" $message warning 0 0 {  OK  }
184
 
}
185
 
 
186
 
proc error {message} {
187
 
    my-message-dialog .error "Error" $message error 0 0 {  OK  }
188
 
}
189
 
    
190
 
proc information {message} {
191
 
    my-message-dialog .info "Information" $message info 0 0 {  OK  }
192
 
}
193
 
    
194
 
proc question {message {defrc 1}} {
195
 
    global tk_priv
196
 
    if {$defrc} {
197
 
        set defbtn 0
198
 
        set canbtn 1
199
 
    } else {
200
 
        set defbtn 1
201
 
        set canbtn 0
202
 
    }
203
 
    return [expr ![my-message-dialog .yesno "Question" $message question\
204
 
            $defbtn $canbtn "Yes" "No"]]
205
 
}
206
 
 
207
 
#----------------------------------------------------------------
208
 
# get the root file name from full path
209
 
#----------------------------------------------------------------
210
 
 
211
 
proc rootname {path} {
212
 
    if {$path == "/"} {
213
 
        return $path
214
 
    } elseif [regexp "\[^/\]+$" $path base] {
215
 
        return $base
216
 
    } elseif [regexp "(\[^/\]+)/$" $path rest base] {
217
 
        return $base
218
 
    } else {
219
 
        return $path
220
 
    }
221
 
}
222
 
 
223
 
#----------------------------------------------------------------
224
 
# pseudo random routine without TclX
225
 
#----------------------------------------------------------------
226
 
 
227
 
set pseudo_random [catch {random 1}]
228
 
set pseudo_random_next -1
229
 
proc my-random {max} {
230
 
    global pseudo_random pseudo_random_next
231
 
    if {$pseudo_random} {
232
 
        set pseudo_random_next [expr $pseudo_random_next * 1103515245 + 12345]
233
 
        return [expr ($pseudo_random_next/65536) % $max]
234
 
        # Or, use bash's random routine instead...
235
 
        # return [expr [exec bash -c {echo $RANDOM}] % $max]
236
 
    } else {
237
 
        return [random $max]
238
 
    }
239
 
}
240
 
proc init-random {num} {
241
 
    global pseudo_random pseudo_random_next
242
 
    if {$pseudo_random} {
243
 
        set pseudo_random_next $num
244
 
    } else {
245
 
        random seed $num
246
 
    }
247
 
}