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;
+}
+
+