annotate tracknamer.tcl @ 11:c122160e07da

Use Tcl 8.2
author darius
date Thu, 18 Jul 2002 06:38:42 +0000
parents 74031379d3cb
children 2bcb84ead02e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3
74031379d3cb Initial revision
darius
parents:
diff changeset
1 #!/bin/sh
74031379d3cb Initial revision
darius
parents:
diff changeset
2 # tcl magic \
74031379d3cb Initial revision
darius
parents:
diff changeset
3 exec tclsh8.0 $0 $*
74031379d3cb Initial revision
darius
parents:
diff changeset
4
74031379d3cb Initial revision
darius
parents:
diff changeset
5 #
74031379d3cb Initial revision
darius
parents:
diff changeset
6 # This software is copyright Daniel O'Connor (darius@dons.net.au) 1998, 1999
74031379d3cb Initial revision
darius
parents:
diff changeset
7 #
74031379d3cb Initial revision
darius
parents:
diff changeset
8 # This software is release under the GNU Public License Version 2.
74031379d3cb Initial revision
darius
parents:
diff changeset
9 # A copy of this licence must be distributed with this software.
74031379d3cb Initial revision
darius
parents:
diff changeset
10 #
74031379d3cb Initial revision
darius
parents:
diff changeset
11
74031379d3cb Initial revision
darius
parents:
diff changeset
12 proc edit_tracks {} {
74031379d3cb Initial revision
darius
parents:
diff changeset
13 global tracks state;
74031379d3cb Initial revision
darius
parents:
diff changeset
14
74031379d3cb Initial revision
darius
parents:
diff changeset
15 # if { [ catch {loadlibs [ list "X11" "tk80" ]} msg] } {
74031379d3cb Initial revision
darius
parents:
diff changeset
16 # log "Failed to load library files - $msg";
74031379d3cb Initial revision
darius
parents:
diff changeset
17 # exit 1;
74031379d3cb Initial revision
darius
parents:
diff changeset
18 # }
74031379d3cb Initial revision
darius
parents:
diff changeset
19
74031379d3cb Initial revision
darius
parents:
diff changeset
20 set tracks(tmp:albumartist) $tracks(albumartist);
74031379d3cb Initial revision
darius
parents:
diff changeset
21 set tracks(tmp:albumname) $tracks(albumname);
74031379d3cb Initial revision
darius
parents:
diff changeset
22 for { set i 1 } { $i <= $tracks(number) } { incr i } {
74031379d3cb Initial revision
darius
parents:
diff changeset
23 set tracks(tmp:artist:$i) $tracks(artist:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
24 set tracks(tmp:title:$i) $tracks(title:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
25 }
74031379d3cb Initial revision
darius
parents:
diff changeset
26
74031379d3cb Initial revision
darius
parents:
diff changeset
27 # create the toplevel
74031379d3cb Initial revision
darius
parents:
diff changeset
28 eval destroy [winfo child .];
74031379d3cb Initial revision
darius
parents:
diff changeset
29 wm title . "Track Edit"
74031379d3cb Initial revision
darius
parents:
diff changeset
30
74031379d3cb Initial revision
darius
parents:
diff changeset
31 # Let's have a menubar
74031379d3cb Initial revision
darius
parents:
diff changeset
32 frame .menubar -relief raised -bd 2
74031379d3cb Initial revision
darius
parents:
diff changeset
33 pack .menubar -side top -fill x
74031379d3cb Initial revision
darius
parents:
diff changeset
34
74031379d3cb Initial revision
darius
parents:
diff changeset
35 # Add the File menu
74031379d3cb Initial revision
darius
parents:
diff changeset
36 menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0;
74031379d3cb Initial revision
darius
parents:
diff changeset
37 menu .menubar.file.m -tearoff 0;
74031379d3cb Initial revision
darius
parents:
diff changeset
38 .menubar.file.m add command -label " Fill Down" -command "fill_down" \
74031379d3cb Initial revision
darius
parents:
diff changeset
39 -underline 2 -accelerator "Ctrl-d";
74031379d3cb Initial revision
darius
parents:
diff changeset
40 .menubar.file.m add command -label " Revert " -command "revert" \
74031379d3cb Initial revision
darius
parents:
diff changeset
41 -underline 2 -accelerator "Ctrl-r";
74031379d3cb Initial revision
darius
parents:
diff changeset
42 .menubar.file.m add command -label " Swap " -command "swap" \
74031379d3cb Initial revision
darius
parents:
diff changeset
43 -underline 2
74031379d3cb Initial revision
darius
parents:
diff changeset
44 .menubar.file.m add separator;
74031379d3cb Initial revision
darius
parents:
diff changeset
45 .menubar.file.m add command -label " Save " -command "save_names" \
74031379d3cb Initial revision
darius
parents:
diff changeset
46 -underline 2 -accelerator "Ctrl-s";
74031379d3cb Initial revision
darius
parents:
diff changeset
47 .menubar.file.m add command -label " Exit " -command "namer_exit" \
74031379d3cb Initial revision
darius
parents:
diff changeset
48 -underline 2 -accelerator "Ctrl-q";
74031379d3cb Initial revision
darius
parents:
diff changeset
49
74031379d3cb Initial revision
darius
parents:
diff changeset
50 pack .menubar.file -side left;
74031379d3cb Initial revision
darius
parents:
diff changeset
51
74031379d3cb Initial revision
darius
parents:
diff changeset
52 # Top frame for entry widgets
74031379d3cb Initial revision
darius
parents:
diff changeset
53 frame .top -relief raised -bd 1
74031379d3cb Initial revision
darius
parents:
diff changeset
54 pack .top -side top -fill both
74031379d3cb Initial revision
darius
parents:
diff changeset
55 # Bottom frame for button
74031379d3cb Initial revision
darius
parents:
diff changeset
56 frame .bot -relief raised -bd 1
74031379d3cb Initial revision
darius
parents:
diff changeset
57 pack .bot -side top -fill both
74031379d3cb Initial revision
darius
parents:
diff changeset
58
74031379d3cb Initial revision
darius
parents:
diff changeset
59 frame .top.disctitle;
74031379d3cb Initial revision
darius
parents:
diff changeset
60 pack .top.disctitle;
74031379d3cb Initial revision
darius
parents:
diff changeset
61 label .top.disctitle.label -text "Disc Title";
74031379d3cb Initial revision
darius
parents:
diff changeset
62 entry .top.disctitle.entry -width 80 -relief sunken -textvariable tracks(tmp:albumname);
74031379d3cb Initial revision
darius
parents:
diff changeset
63 pack .top.disctitle.label .top.disctitle.entry -side left;
74031379d3cb Initial revision
darius
parents:
diff changeset
64 frame .top.discartist;
74031379d3cb Initial revision
darius
parents:
diff changeset
65 pack .top.discartist;
74031379d3cb Initial revision
darius
parents:
diff changeset
66 label .top.discartist.label -text "Disc Artist";
74031379d3cb Initial revision
darius
parents:
diff changeset
67 entry .top.discartist.entry -width 80 -relief sunken -textvariable tracks(tmp:albumartist);
74031379d3cb Initial revision
darius
parents:
diff changeset
68 pack .top.discartist.label .top.discartist.entry -side left;
74031379d3cb Initial revision
darius
parents:
diff changeset
69
74031379d3cb Initial revision
darius
parents:
diff changeset
70 label .top.label -text "Artist/Title";
74031379d3cb Initial revision
darius
parents:
diff changeset
71 pack .top.label;
74031379d3cb Initial revision
darius
parents:
diff changeset
72
74031379d3cb Initial revision
darius
parents:
diff changeset
73 add_entries .top
74031379d3cb Initial revision
darius
parents:
diff changeset
74
74031379d3cb Initial revision
darius
parents:
diff changeset
75 button .bot.revert -text Save -command save_names;
74031379d3cb Initial revision
darius
parents:
diff changeset
76 button .bot.save -text Revert -command revert;
74031379d3cb Initial revision
darius
parents:
diff changeset
77 pack .bot.revert .bot.save -side left;
74031379d3cb Initial revision
darius
parents:
diff changeset
78
74031379d3cb Initial revision
darius
parents:
diff changeset
79 bind all <Control-q> {namer_exit}
74031379d3cb Initial revision
darius
parents:
diff changeset
80 bind all <Control-s> {save_names}
74031379d3cb Initial revision
darius
parents:
diff changeset
81 bind all <Control-d> {fill_down}
74031379d3cb Initial revision
darius
parents:
diff changeset
82 bind all <Control-r> {revert}
74031379d3cb Initial revision
darius
parents:
diff changeset
83 update;
74031379d3cb Initial revision
darius
parents:
diff changeset
84
74031379d3cb Initial revision
darius
parents:
diff changeset
85 vwait state(exitnow);
74031379d3cb Initial revision
darius
parents:
diff changeset
86 destroy .
74031379d3cb Initial revision
darius
parents:
diff changeset
87 catch {update};
74031379d3cb Initial revision
darius
parents:
diff changeset
88 }
74031379d3cb Initial revision
darius
parents:
diff changeset
89
74031379d3cb Initial revision
darius
parents:
diff changeset
90
74031379d3cb Initial revision
darius
parents:
diff changeset
91 proc swap {} {
74031379d3cb Initial revision
darius
parents:
diff changeset
92 global tracks;
74031379d3cb Initial revision
darius
parents:
diff changeset
93
74031379d3cb Initial revision
darius
parents:
diff changeset
94 for { set i 1 } { $i <= $tracks(number) } { incr i } {
74031379d3cb Initial revision
darius
parents:
diff changeset
95 set tmp $tracks(tmp:title:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
96 set tracks(tmp:title:$i) $tracks(tmp:artist:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
97 set tracks(tmp:artist:$i) $tmp;
74031379d3cb Initial revision
darius
parents:
diff changeset
98 }
74031379d3cb Initial revision
darius
parents:
diff changeset
99 }
74031379d3cb Initial revision
darius
parents:
diff changeset
100
74031379d3cb Initial revision
darius
parents:
diff changeset
101 proc fill_down {} {
74031379d3cb Initial revision
darius
parents:
diff changeset
102 global tracks;
74031379d3cb Initial revision
darius
parents:
diff changeset
103
74031379d3cb Initial revision
darius
parents:
diff changeset
104 for { set i 2 } { $i <= $tracks(number) } { incr i } {
74031379d3cb Initial revision
darius
parents:
diff changeset
105 set tracks(tmp:artist:$i) $tracks(tmp:artist:1);
74031379d3cb Initial revision
darius
parents:
diff changeset
106 }
74031379d3cb Initial revision
darius
parents:
diff changeset
107 }
74031379d3cb Initial revision
darius
parents:
diff changeset
108
74031379d3cb Initial revision
darius
parents:
diff changeset
109 proc revert {} {
74031379d3cb Initial revision
darius
parents:
diff changeset
110 global tracks;
74031379d3cb Initial revision
darius
parents:
diff changeset
111
74031379d3cb Initial revision
darius
parents:
diff changeset
112 set tracks(tmp:albumname) $tracks(albumname);
74031379d3cb Initial revision
darius
parents:
diff changeset
113 set tracks(tmp:albumartist) $tracks(albumartist);
74031379d3cb Initial revision
darius
parents:
diff changeset
114
74031379d3cb Initial revision
darius
parents:
diff changeset
115 for { set i 1 } { $i <= $tracks(number) } { incr i } {
74031379d3cb Initial revision
darius
parents:
diff changeset
116 set tracks(tmp:artist:$i) $tracks(artist:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
117 set tracks(tmp:title:$i) $tracks(title:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
118 }
74031379d3cb Initial revision
darius
parents:
diff changeset
119 }
74031379d3cb Initial revision
darius
parents:
diff changeset
120
74031379d3cb Initial revision
darius
parents:
diff changeset
121 proc add_entries { parent } {
74031379d3cb Initial revision
darius
parents:
diff changeset
122 global tracks;
74031379d3cb Initial revision
darius
parents:
diff changeset
123
74031379d3cb Initial revision
darius
parents:
diff changeset
124 for { set i 1 } { $i <= $tracks(number) } { incr i } {
74031379d3cb Initial revision
darius
parents:
diff changeset
125 frame $parent.fr_track:$i;
74031379d3cb Initial revision
darius
parents:
diff changeset
126 pack $parent.fr_track:$i -side top;
74031379d3cb Initial revision
darius
parents:
diff changeset
127
74031379d3cb Initial revision
darius
parents:
diff changeset
128 label $parent.fr_track:$i.label -text "Track $i:";
74031379d3cb Initial revision
darius
parents:
diff changeset
129 entry $parent.fr_track:$i.ar_entry -width 40 -relief sunken -textvariable tracks(tmp:artist:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
130 entry $parent.fr_track:$i.ti_entry -width 40 -relief sunken -textvariable tracks(tmp:title:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
131 pack $parent.fr_track:$i.label $parent.fr_track:$i.ar_entry $parent.fr_track:$i.ti_entry -side left;
74031379d3cb Initial revision
darius
parents:
diff changeset
132
74031379d3cb Initial revision
darius
parents:
diff changeset
133 # log "Title $i";
74031379d3cb Initial revision
darius
parents:
diff changeset
134 }
74031379d3cb Initial revision
darius
parents:
diff changeset
135 }
74031379d3cb Initial revision
darius
parents:
diff changeset
136 proc save_names {} {
74031379d3cb Initial revision
darius
parents:
diff changeset
137 global tracks;
74031379d3cb Initial revision
darius
parents:
diff changeset
138
74031379d3cb Initial revision
darius
parents:
diff changeset
139 set tracks(albumname) $tracks(tmp:albumname);
74031379d3cb Initial revision
darius
parents:
diff changeset
140 set $tracks(albumartist) tracks(tmp:albumartist);
74031379d3cb Initial revision
darius
parents:
diff changeset
141
74031379d3cb Initial revision
darius
parents:
diff changeset
142 for { set i 1 } { $i <= $tracks(number) } { incr i } {
74031379d3cb Initial revision
darius
parents:
diff changeset
143 set tracks(artist:$i) $tracks(tmp:artist:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
144 set tracks(title:$i) $tracks(tmp:title:$i);
74031379d3cb Initial revision
darius
parents:
diff changeset
145 }
74031379d3cb Initial revision
darius
parents:
diff changeset
146
74031379d3cb Initial revision
darius
parents:
diff changeset
147 set tracks(updated) 1;
74031379d3cb Initial revision
darius
parents:
diff changeset
148 # print_info;
74031379d3cb Initial revision
darius
parents:
diff changeset
149
74031379d3cb Initial revision
darius
parents:
diff changeset
150 }
74031379d3cb Initial revision
darius
parents:
diff changeset
151
74031379d3cb Initial revision
darius
parents:
diff changeset
152 proc print_info {} {
74031379d3cb Initial revision
darius
parents:
diff changeset
153 global tracks;
74031379d3cb Initial revision
darius
parents:
diff changeset
154
74031379d3cb Initial revision
darius
parents:
diff changeset
155 puts "Title: $tracks(albumname)";
74031379d3cb Initial revision
darius
parents:
diff changeset
156 puts "Artist: $tracks(albumartist)";
74031379d3cb Initial revision
darius
parents:
diff changeset
157
74031379d3cb Initial revision
darius
parents:
diff changeset
158 for { set i 1 } { $i <= $tracks(number) } { incr i } {
74031379d3cb Initial revision
darius
parents:
diff changeset
159 puts "Track $i: $tracks(artist:$i) - $tracks(title:$i)";
74031379d3cb Initial revision
darius
parents:
diff changeset
160 }
74031379d3cb Initial revision
darius
parents:
diff changeset
161 }
74031379d3cb Initial revision
darius
parents:
diff changeset
162 proc namer_exit {} {
74031379d3cb Initial revision
darius
parents:
diff changeset
163 global state;
74031379d3cb Initial revision
darius
parents:
diff changeset
164
74031379d3cb Initial revision
darius
parents:
diff changeset
165 # log "Bye";
74031379d3cb Initial revision
darius
parents:
diff changeset
166 # print_info;
74031379d3cb Initial revision
darius
parents:
diff changeset
167 set state(exitnow) 1;
74031379d3cb Initial revision
darius
parents:
diff changeset
168 }
74031379d3cb Initial revision
darius
parents:
diff changeset
169
74031379d3cb Initial revision
darius
parents:
diff changeset
170 ##################################################################
74031379d3cb Initial revision
darius
parents:
diff changeset
171 # Load a list of libraries.
74031379d3cb Initial revision
darius
parents:
diff changeset
172 # Takes a list of the form { "foo" "bar" } to look for
74031379d3cb Initial revision
darius
parents:
diff changeset
173 # libfoo.so.n.m and libbar.so.n.m.
74031379d3cb Initial revision
darius
parents:
diff changeset
174 # Also looks at the LD_LIBRARY_PATH variable for extra places to look
74031379d3cb Initial revision
darius
parents:
diff changeset
175 #
74031379d3cb Initial revision
darius
parents:
diff changeset
176 proc loadlibs {liblist} {
74031379d3cb Initial revision
darius
parents:
diff changeset
177 global env;
74031379d3cb Initial revision
darius
parents:
diff changeset
178
74031379d3cb Initial revision
darius
parents:
diff changeset
179 set file [open {|/sbin/ldconfig -r} r]
74031379d3cb Initial revision
darius
parents:
diff changeset
180 while { ! [eof $file] } {
74031379d3cb Initial revision
darius
parents:
diff changeset
181 if { [ regexp {[0-9]+:-l(.*) => (.*)/lib(.*)\.so\.(.*)} [gets $file] a b c d e ] == 0 } {
74031379d3cb Initial revision
darius
parents:
diff changeset
182 continue;
74031379d3cb Initial revision
darius
parents:
diff changeset
183 }
74031379d3cb Initial revision
darius
parents:
diff changeset
184
74031379d3cb Initial revision
darius
parents:
diff changeset
185 # List of partially processed libs
74031379d3cb Initial revision
darius
parents:
diff changeset
186 # eg '/usr/local/lib' 'tiff34' '1.0'
74031379d3cb Initial revision
darius
parents:
diff changeset
187 if { [ regexp {(.*)\.(.*)} $e f g h ] == 0 } {
74031379d3cb Initial revision
darius
parents:
diff changeset
188 set maj $e;
74031379d3cb Initial revision
darius
parents:
diff changeset
189 set min 0;
74031379d3cb Initial revision
darius
parents:
diff changeset
190 } else {
74031379d3cb Initial revision
darius
parents:
diff changeset
191 set maj $g;
74031379d3cb Initial revision
darius
parents:
diff changeset
192 set min $h;
74031379d3cb Initial revision
darius
parents:
diff changeset
193 }
74031379d3cb Initial revision
darius
parents:
diff changeset
194 set tmp [ list $c $d $maj $min ];
74031379d3cb Initial revision
darius
parents:
diff changeset
195 # puts "ldconfig - $tmp";
74031379d3cb Initial revision
darius
parents:
diff changeset
196 lappend all_list $tmp;
74031379d3cb Initial revision
darius
parents:
diff changeset
197 }
74031379d3cb Initial revision
darius
parents:
diff changeset
198
74031379d3cb Initial revision
darius
parents:
diff changeset
199 close $file;
74031379d3cb Initial revision
darius
parents:
diff changeset
200
74031379d3cb Initial revision
darius
parents:
diff changeset
201 if { [ info exists env(LD_LIBRARY_PATH) ] == 1} {
74031379d3cb Initial revision
darius
parents:
diff changeset
202 set ld_path [ split $env(LD_LIBRARY_PATH) ":"];
74031379d3cb Initial revision
darius
parents:
diff changeset
203
74031379d3cb Initial revision
darius
parents:
diff changeset
204 foreach dir $ld_path {
74031379d3cb Initial revision
darius
parents:
diff changeset
205 set found [glob -nocomplain -- "$dir/lib*.so.*"];
74031379d3cb Initial revision
darius
parents:
diff changeset
206 if { $found != "" } {
74031379d3cb Initial revision
darius
parents:
diff changeset
207 foreach foo $found {
74031379d3cb Initial revision
darius
parents:
diff changeset
208 if { [ regexp {(.*)/lib(.*)\.so\.(.*)} $foo a b c d ] == 0 } {
74031379d3cb Initial revision
darius
parents:
diff changeset
209 continue;
74031379d3cb Initial revision
darius
parents:
diff changeset
210 }
74031379d3cb Initial revision
darius
parents:
diff changeset
211
74031379d3cb Initial revision
darius
parents:
diff changeset
212 if { [ regexp {(.*)\.(.*)} $d e f g ] == 0 } {
74031379d3cb Initial revision
darius
parents:
diff changeset
213 set maj $d;
74031379d3cb Initial revision
darius
parents:
diff changeset
214 set min 0;
74031379d3cb Initial revision
darius
parents:
diff changeset
215 } else {
74031379d3cb Initial revision
darius
parents:
diff changeset
216 set maj $f;
74031379d3cb Initial revision
darius
parents:
diff changeset
217 set min $g;
74031379d3cb Initial revision
darius
parents:
diff changeset
218 }
74031379d3cb Initial revision
darius
parents:
diff changeset
219 set tmp [ list $b $c $maj $min ];
74031379d3cb Initial revision
darius
parents:
diff changeset
220 # puts "LD_LIB - $tmp";
74031379d3cb Initial revision
darius
parents:
diff changeset
221 lappend all_list $tmp;
74031379d3cb Initial revision
darius
parents:
diff changeset
222 }
74031379d3cb Initial revision
darius
parents:
diff changeset
223 }
74031379d3cb Initial revision
darius
parents:
diff changeset
224 }
74031379d3cb Initial revision
darius
parents:
diff changeset
225 }
74031379d3cb Initial revision
darius
parents:
diff changeset
226
74031379d3cb Initial revision
darius
parents:
diff changeset
227 set libs_to_load "";
74031379d3cb Initial revision
darius
parents:
diff changeset
228
74031379d3cb Initial revision
darius
parents:
diff changeset
229 foreach lib $liblist {
74031379d3cb Initial revision
darius
parents:
diff changeset
230 set found_lib "";
74031379d3cb Initial revision
darius
parents:
diff changeset
231 set found_maj 0;
74031379d3cb Initial revision
darius
parents:
diff changeset
232 set found_min 0;
74031379d3cb Initial revision
darius
parents:
diff changeset
233
74031379d3cb Initial revision
darius
parents:
diff changeset
234 foreach line $all_list {
74031379d3cb Initial revision
darius
parents:
diff changeset
235 # Path
74031379d3cb Initial revision
darius
parents:
diff changeset
236 set b [ lindex $line 0 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
237 # Lib name
74031379d3cb Initial revision
darius
parents:
diff changeset
238 set e [ lindex $line 1 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
239 # Major
74031379d3cb Initial revision
darius
parents:
diff changeset
240 set c [ lindex $line 2 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
241 # Minor
74031379d3cb Initial revision
darius
parents:
diff changeset
242 set d [ lindex $line 3 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
243 if { ($e == $lib) && (($c > $found_maj) || (($c == $found_maj) && ($d > $found_min))) } {
74031379d3cb Initial revision
darius
parents:
diff changeset
244 set found_maj $c;
74031379d3cb Initial revision
darius
parents:
diff changeset
245 set found_min $d;
74031379d3cb Initial revision
darius
parents:
diff changeset
246 set found_lib $e;
74031379d3cb Initial revision
darius
parents:
diff changeset
247 set found_path $b;
74031379d3cb Initial revision
darius
parents:
diff changeset
248 # puts "Found $found_lib ($found_maj.$found_min)";
74031379d3cb Initial revision
darius
parents:
diff changeset
249 }
74031379d3cb Initial revision
darius
parents:
diff changeset
250 }
74031379d3cb Initial revision
darius
parents:
diff changeset
251
74031379d3cb Initial revision
darius
parents:
diff changeset
252 if { $found_lib != "" } {
74031379d3cb Initial revision
darius
parents:
diff changeset
253 lappend libs_to_load [ list $found_lib $found_path $found_maj $found_min ];
74031379d3cb Initial revision
darius
parents:
diff changeset
254 } else {
74031379d3cb Initial revision
darius
parents:
diff changeset
255 error "Unable to find library for $lib";
74031379d3cb Initial revision
darius
parents:
diff changeset
256 }
74031379d3cb Initial revision
darius
parents:
diff changeset
257 }
74031379d3cb Initial revision
darius
parents:
diff changeset
258
74031379d3cb Initial revision
darius
parents:
diff changeset
259 set loaded_OK "";
74031379d3cb Initial revision
darius
parents:
diff changeset
260
74031379d3cb Initial revision
darius
parents:
diff changeset
261 foreach lib $libs_to_load {
74031379d3cb Initial revision
darius
parents:
diff changeset
262 set libname [ lindex $lib 0 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
263 set libpath [ lindex $lib 1 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
264 set libmaj [ lindex $lib 2 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
265 set libmin [ lindex $lib 3 ];
74031379d3cb Initial revision
darius
parents:
diff changeset
266 # Try no extension for ELF
74031379d3cb Initial revision
darius
parents:
diff changeset
267 if { $libmin == 0 } {
74031379d3cb Initial revision
darius
parents:
diff changeset
268 if { [ file exists $libpath/lib$libname.so.$libmaj ] } {
74031379d3cb Initial revision
darius
parents:
diff changeset
269 set loadname $libpath/lib$libname.so.$libmaj
74031379d3cb Initial revision
darius
parents:
diff changeset
270 } else {
74031379d3cb Initial revision
darius
parents:
diff changeset
271 set loadname $libpath/lib$libname.so.$libmaj.$libmin
74031379d3cb Initial revision
darius
parents:
diff changeset
272 }
74031379d3cb Initial revision
darius
parents:
diff changeset
273 } else {
74031379d3cb Initial revision
darius
parents:
diff changeset
274 set loadname $libpath/lib$libname.so.$libmaj.$libmin
74031379d3cb Initial revision
darius
parents:
diff changeset
275 }
74031379d3cb Initial revision
darius
parents:
diff changeset
276 if { [catch {load $loadname} msg ] } {
74031379d3cb Initial revision
darius
parents:
diff changeset
277 # Ignore the error if it's because it couldn't find the procedure - needed for X11
74031379d3cb Initial revision
darius
parents:
diff changeset
278 if { [regexp -nocase .*couldn\'t\ find\ procedure.* $msg ] == 0 } {
74031379d3cb Initial revision
darius
parents:
diff changeset
279 error "Warning: Couldn't load $lib because $msg";
74031379d3cb Initial revision
darius
parents:
diff changeset
280 } else {
74031379d3cb Initial revision
darius
parents:
diff changeset
281 lappend loaded_OK $libname;
74031379d3cb Initial revision
darius
parents:
diff changeset
282 }
74031379d3cb Initial revision
darius
parents:
diff changeset
283 } else {
74031379d3cb Initial revision
darius
parents:
diff changeset
284 lappend loaded_OK $lib;
74031379d3cb Initial revision
darius
parents:
diff changeset
285 }
74031379d3cb Initial revision
darius
parents:
diff changeset
286 }
74031379d3cb Initial revision
darius
parents:
diff changeset
287
74031379d3cb Initial revision
darius
parents:
diff changeset
288 return $loaded_OK;
74031379d3cb Initial revision
darius
parents:
diff changeset
289 }
74031379d3cb Initial revision
darius
parents:
diff changeset
290
74031379d3cb Initial revision
darius
parents:
diff changeset
291 proc log {format args} {
74031379d3cb Initial revision
darius
parents:
diff changeset
292 # Extract the calling function's name
74031379d3cb Initial revision
darius
parents:
diff changeset
293 set fname [lindex [info level -1] 0];
74031379d3cb Initial revision
darius
parents:
diff changeset
294
74031379d3cb Initial revision
darius
parents:
diff changeset
295 # Evaluate the supplied format string and arguments
74031379d3cb Initial revision
darius
parents:
diff changeset
296 if {[catch {set csm [eval format {$format} $args]} msg]} {
74031379d3cb Initial revision
darius
parents:
diff changeset
297 set csm "bad log message. format='$format' args='$args'";
74031379d3cb Initial revision
darius
parents:
diff changeset
298 }
74031379d3cb Initial revision
darius
parents:
diff changeset
299
74031379d3cb Initial revision
darius
parents:
diff changeset
300 # Emit the message
74031379d3cb Initial revision
darius
parents:
diff changeset
301 puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
74031379d3cb Initial revision
darius
parents:
diff changeset
302 flush stderr;
74031379d3cb Initial revision
darius
parents:
diff changeset
303 }
74031379d3cb Initial revision
darius
parents:
diff changeset
304
74031379d3cb Initial revision
darius
parents:
diff changeset
305