Mercurial > ~darius > hgwebdir.cgi > cddb-stuff
view tracknamer.tcl @ 4:3a7a8d8a070a
Added tag CDDB-STUFF_1_0 for changeset 74031379d3cb
author | darius@midget.dons.net.au |
---|---|
date | Tue, 23 Oct 2007 10:08:25 +0930 |
parents | 74031379d3cb |
children | 2bcb84ead02e |
line wrap: on
line source
#!/bin/sh # tcl magic \ exec tclsh8.0 $0 $* # # This software is copyright Daniel O'Connor (darius@dons.net.au) 1998, 1999 # # This software is release under the GNU Public License Version 2. # A copy of this licence must be distributed with this software. # proc edit_tracks {} { global tracks state; # if { [ catch {loadlibs [ list "X11" "tk80" ]} msg] } { # log "Failed to load library files - $msg"; # exit 1; # } set tracks(tmp:albumartist) $tracks(albumartist); set tracks(tmp:albumname) $tracks(albumname); for { set i 1 } { $i <= $tracks(number) } { incr i } { set tracks(tmp:artist:$i) $tracks(artist:$i); set tracks(tmp:title:$i) $tracks(title:$i); } # create the toplevel eval destroy [winfo child .]; wm title . "Track Edit" # Let's have a menubar frame .menubar -relief raised -bd 2 pack .menubar -side top -fill x # Add the File menu menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0; menu .menubar.file.m -tearoff 0; .menubar.file.m add command -label " Fill Down" -command "fill_down" \ -underline 2 -accelerator "Ctrl-d"; .menubar.file.m add command -label " Revert " -command "revert" \ -underline 2 -accelerator "Ctrl-r"; .menubar.file.m add command -label " Swap " -command "swap" \ -underline 2 .menubar.file.m add separator; .menubar.file.m add command -label " Save " -command "save_names" \ -underline 2 -accelerator "Ctrl-s"; .menubar.file.m add command -label " Exit " -command "namer_exit" \ -underline 2 -accelerator "Ctrl-q"; pack .menubar.file -side left; # Top frame for entry widgets frame .top -relief raised -bd 1 pack .top -side top -fill both # Bottom frame for button frame .bot -relief raised -bd 1 pack .bot -side top -fill both frame .top.disctitle; pack .top.disctitle; label .top.disctitle.label -text "Disc Title"; entry .top.disctitle.entry -width 80 -relief sunken -textvariable tracks(tmp:albumname); pack .top.disctitle.label .top.disctitle.entry -side left; frame .top.discartist; pack .top.discartist; label .top.discartist.label -text "Disc Artist"; entry .top.discartist.entry -width 80 -relief sunken -textvariable tracks(tmp:albumartist); pack .top.discartist.label .top.discartist.entry -side left; label .top.label -text "Artist/Title"; pack .top.label; add_entries .top button .bot.revert -text Save -command save_names; button .bot.save -text Revert -command revert; pack .bot.revert .bot.save -side left; bind all <Control-q> {namer_exit} bind all <Control-s> {save_names} bind all <Control-d> {fill_down} bind all <Control-r> {revert} update; vwait state(exitnow); destroy . catch {update}; } proc swap {} { global tracks; for { set i 1 } { $i <= $tracks(number) } { incr i } { set tmp $tracks(tmp:title:$i); set tracks(tmp:title:$i) $tracks(tmp:artist:$i); set tracks(tmp:artist:$i) $tmp; } } proc fill_down {} { global tracks; for { set i 2 } { $i <= $tracks(number) } { incr i } { set tracks(tmp:artist:$i) $tracks(tmp:artist:1); } } proc revert {} { global tracks; set tracks(tmp:albumname) $tracks(albumname); set tracks(tmp:albumartist) $tracks(albumartist); for { set i 1 } { $i <= $tracks(number) } { incr i } { set tracks(tmp:artist:$i) $tracks(artist:$i); set tracks(tmp:title:$i) $tracks(title:$i); } } proc add_entries { parent } { global tracks; for { set i 1 } { $i <= $tracks(number) } { incr i } { frame $parent.fr_track:$i; pack $parent.fr_track:$i -side top; label $parent.fr_track:$i.label -text "Track $i:"; entry $parent.fr_track:$i.ar_entry -width 40 -relief sunken -textvariable tracks(tmp:artist:$i); entry $parent.fr_track:$i.ti_entry -width 40 -relief sunken -textvariable tracks(tmp:title:$i); pack $parent.fr_track:$i.label $parent.fr_track:$i.ar_entry $parent.fr_track:$i.ti_entry -side left; # log "Title $i"; } } proc save_names {} { global tracks; set tracks(albumname) $tracks(tmp:albumname); set $tracks(albumartist) tracks(tmp:albumartist); for { set i 1 } { $i <= $tracks(number) } { incr i } { set tracks(artist:$i) $tracks(tmp:artist:$i); set tracks(title:$i) $tracks(tmp:title:$i); } set tracks(updated) 1; # print_info; } proc print_info {} { global tracks; puts "Title: $tracks(albumname)"; puts "Artist: $tracks(albumartist)"; for { set i 1 } { $i <= $tracks(number) } { incr i } { puts "Track $i: $tracks(artist:$i) - $tracks(title:$i)"; } } proc namer_exit {} { global state; # log "Bye"; # print_info; set state(exitnow) 1; } ################################################################## # Load a list of libraries. # Takes a list of the form { "foo" "bar" } to look for # libfoo.so.n.m and libbar.so.n.m. # Also looks at the LD_LIBRARY_PATH variable for extra places to look # proc loadlibs {liblist} { global env; set file [open {|/sbin/ldconfig -r} r] while { ! [eof $file] } { if { [ regexp {[0-9]+:-l(.*) => (.*)/lib(.*)\.so\.(.*)} [gets $file] a b c d e ] == 0 } { continue; } # List of partially processed libs # eg '/usr/local/lib' 'tiff34' '1.0' if { [ regexp {(.*)\.(.*)} $e f g h ] == 0 } { set maj $e; set min 0; } else { set maj $g; set min $h; } set tmp [ list $c $d $maj $min ]; # puts "ldconfig - $tmp"; lappend all_list $tmp; } close $file; if { [ info exists env(LD_LIBRARY_PATH) ] == 1} { set ld_path [ split $env(LD_LIBRARY_PATH) ":"]; foreach dir $ld_path { set found [glob -nocomplain -- "$dir/lib*.so.*"]; if { $found != "" } { foreach foo $found { if { [ regexp {(.*)/lib(.*)\.so\.(.*)} $foo a b c d ] == 0 } { continue; } if { [ regexp {(.*)\.(.*)} $d e f g ] == 0 } { set maj $d; set min 0; } else { set maj $f; set min $g; } set tmp [ list $b $c $maj $min ]; # puts "LD_LIB - $tmp"; lappend all_list $tmp; } } } } set libs_to_load ""; foreach lib $liblist { set found_lib ""; set found_maj 0; set found_min 0; foreach line $all_list { # Path set b [ lindex $line 0 ]; # Lib name set e [ lindex $line 1 ]; # Major set c [ lindex $line 2 ]; # Minor set d [ lindex $line 3 ]; if { ($e == $lib) && (($c > $found_maj) || (($c == $found_maj) && ($d > $found_min))) } { set found_maj $c; set found_min $d; set found_lib $e; set found_path $b; # puts "Found $found_lib ($found_maj.$found_min)"; } } if { $found_lib != "" } { lappend libs_to_load [ list $found_lib $found_path $found_maj $found_min ]; } else { error "Unable to find library for $lib"; } } set loaded_OK ""; foreach lib $libs_to_load { set libname [ lindex $lib 0 ]; set libpath [ lindex $lib 1 ]; set libmaj [ lindex $lib 2 ]; set libmin [ lindex $lib 3 ]; # Try no extension for ELF if { $libmin == 0 } { if { [ file exists $libpath/lib$libname.so.$libmaj ] } { set loadname $libpath/lib$libname.so.$libmaj } else { set loadname $libpath/lib$libname.so.$libmaj.$libmin } } else { set loadname $libpath/lib$libname.so.$libmaj.$libmin } if { [catch {load $loadname} msg ] } { # Ignore the error if it's because it couldn't find the procedure - needed for X11 if { [regexp -nocase .*couldn\'t\ find\ procedure.* $msg ] == 0 } { error "Warning: Couldn't load $lib because $msg"; } else { lappend loaded_OK $libname; } } else { lappend loaded_OK $lib; } } return $loaded_OK; } proc log {format args} { # Extract the calling function's name set fname [lindex [info level -1] 0]; # Evaluate the supplied format string and arguments if {[catch {set csm [eval format {$format} $args]} msg]} { set csm "bad log message. format='$format' args='$args'"; } # Emit the message puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm"; flush stderr; }