Mercurial > ~darius > hgwebdir.cgi > cddb-stuff

comparison tracknamer.tcl @ 3:74031379d3cb CDDB-STUFF_1_0

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