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