Mercurial > ~darius > hgwebdir.cgi > cddb-stuff
diff tracknamer.tcl @ 3:74031379d3cb CDDB-STUFF_1_0
Initial revision
author | darius |
---|---|
date | Wed, 09 Aug 2000 02:18:47 +0000 |
parents | |
children | 2bcb84ead02e |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tracknamer.tcl Wed Aug 09 02:18:47 2000 +0000 @@ -0,0 +1,305 @@ +#!/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; +} + +