#!/usr/bin/wish

##                                                                          ##
## Object Dive - a script by Norman Feske written in Feb'2003               ##
##                                                                          ##
## This tool interactively displays dependencies between object files.      ##                                                                   ##
##                                                                          ##
## This file is released under the terms of the  GNU General Public Licence ##
##                                                                          ##

set portnum     27285
set init_width  800
set init_height 600
set nm nm

if {[llength $argv] < 1} {
	puts "ObjDive - a tool for displaying object dependencies"
	puts "usage: objdive <file1.o ... filex.o>"
	exit
}


###+- PLACE NODES RANDOMLY -+###
proc init_nodes {num_columns} {
	global desk obj_files file_xpos file_ypos hide_cols
	set desk_h [lindex [$desk configure -height] 4]
	set num_objs [llength $obj_files]
	if {$num_objs < 1} return
	set dy [expr $desk_h*$num_columns / $num_objs]
	set ypos 20
	set col 0
	foreach obj_file $obj_files {
		set file_xpos($obj_file) [expr 40 + 80*$col]
		set file_ypos($obj_file) $ypos
		incr col
		if {$col == $hide_cols} {
			set col 0
			set ypos [expr $ypos + $dy]
		}
	}
}


###+- REALLY LAME RANDOM FUNCTION (OPTIMIZED FOR SPEED,-) -+###
proc random {max_val} {
	return [expr [exec sh -c "echo \$RANDOM"] % $max_val]
}


###+- PLACE NODES RANDOMLY -+###
proc random_nodes {} {
	global desk obj_files file_xpos file_ypos hide_x
	set desk_w [lindex [$desk configure -width] 4]
	set desk_h [lindex [$desk configure -height] 4]
	foreach obj_file $obj_files {
		set xpos [expr [random [expr $desk_w - 60 - $hide_x]] + 30 + $hide_x ]
		set ypos [expr [random [expr $desk_h - 20]] + 10 ]
		set file_xpos($obj_file) $xpos
		set file_ypos($obj_file) $ypos
		move_node $xpos $ypos $obj_file
	}
}


###+- MOVE NODE TO ANOTHER POSITION AND UPDATE ITS CONNECTED EDGES -+##
proc move_node {new_x new_y obj_file} {
	global desk file_xpos file_ypos file_nametag file_boxtag edge_list
	
	$desk coords $file_boxtag($obj_file) \
							[expr \$new_x-30] [expr \$new_y-10] \
							[expr \$new_x+30] [expr \$new_y+10]
	$desk coords $file_nametag($obj_file) 	$new_x $new_y
	set file_xpos($obj_file) $new_x
	set file_ypos($obj_file) $new_y
	foreach edge $edge_list {
		set src_file [lindex $edge 0]
		set dst_file [lindex $edge 1]
		if {$src_file == $obj_file} {
			place_edge $src_file $dst_file
		}
		if {$dst_file == $obj_file} {
			place_edge $src_file $dst_file
		}
	}
}


###+- SELECT A NODE AND ITS OUTGOING EDGES AND UPDATE NODE INFO WINDOW -+###
proc select_node {obj_file} {
	global desk cur_sel_node file_boxtag file_nametag edge_list edge_tag
	global edge_sel
	set_sym_src "undefined"

	# deselect old selection
	if {$cur_sel_node != "undefined"} {
		foreach edge $edge_list {
			set src_file [lindex $edge 0]
			set dst_file [lindex $edge 1]
			if {$src_file == $cur_sel_node} {
				$desk itemconfigure $edge_tag($src_file,$dst_file) -fill #777777
				set edge_sel($src_file,$dst_file) 0
			}
		}
		$desk itemconfigure $file_boxtag($cur_sel_node) -fill #efefef
	}

	# select node and its corresponding edges
	set cur_sel_node $obj_file
	foreach edge $edge_list {
		set src_file [lindex $edge 0]
		set dst_file [lindex $edge 1]
		if {$src_file == $obj_file} {
			$desk itemconfigure $edge_tag($src_file,$dst_file) -fill #3333bb
			$desk raise $edge_tag($src_file,$dst_file)
			set edge_sel($src_file,$dst_file) 1
		}

	}
	$desk itemconfigure $file_boxtag($obj_file) -fill #ccccff
	$desk raise $file_boxtag($obj_file)
	$desk raise $file_nametag($obj_file)

	fill_syminfo_win $obj_file
}


proc select_edge {new_src_file new_dst_file} {
	global desk cur_sel_edge edge_tag edge_sel

	if {$cur_sel_edge != "undefined"} {
		set src_file [lindex $cur_sel_edge 0]
		set dst_file [lindex $cur_sel_edge 1]
		if {$edge_sel($src_file,$dst_file)} {
			$desk itemconfigure $edge_tag($src_file,$dst_file) -fill #3333aa
		} else {
			$desk itemconfigure $edge_tag($src_file,$dst_file) -fill #777777
		}
	}
	set cur_sel_edge [list $new_src_file $new_dst_file]
	$desk itemconfigure $edge_tag($new_src_file,$new_dst_file) -fill #882211
	$desk raise $edge_tag($new_src_file,$new_dst_file)
	
	fill_edginfo_win $new_src_file $new_dst_file
}


###+- CREATE NODES ON CANVAS -+###
proc draw_nodes {} {
	global desk obj_files file_xpos file_ypos file_boxtag file_nametag
	global new_x new_y
	foreach obj_file $obj_files {
		set xpos $file_xpos($obj_file)
		set ypos $file_ypos($obj_file)
		set boxtag [$desk create oval 	[expr $xpos-30] [expr $ypos-10] \
								[expr $xpos+30] [expr $ypos+10] \
								-fill #efefef -width 1 -outline #efefef]
		set nametag [$desk create text $xpos $ypos -anchor center -text $obj_file]
		set file_boxtag($obj_file) $boxtag
		set file_nametag($obj_file) $nametag
		$desk bind $nametag <B1-Motion> "move_node %x %y $obj_file"
		$desk bind $boxtag  <B1-Motion> "move_node %x %y $obj_file"
		$desk bind $nametag <Button> "select_node $obj_file"
		$desk bind $boxtag  <Button> "select_node $obj_file"
	}
}


proc init_connections {} {
	global obj_files file_ext sym_imp_file edge_w edge_list max_edge_w
	global edge_sel
	set edge_list {}
	foreach src_file $obj_files {
		set ext_syms $file_ext($src_file)
		
		foreach ext_sym $ext_syms {
			set dst_file "undefined"
			catch {
				set dst_file $sym_imp_file($ext_sym)
			}
			set edge_sel($src_file,$dst_file) 0
			if {$dst_file != "undefined"} {
				if {![info exists edge_w($src_file,$dst_file)]} {
					set edge_w($src_file,$dst_file) 1
				} else {
					incr edge_w($src_file,$dst_file)
					if {$edge_w($src_file,$dst_file) > $max_edge_w} { 
						set max_edge_w $edge_w($src_file,$dst_file)
					}
				}
				set edge "$src_file $dst_file"
				if {[lsearch $edge_list $edge] == -1} {
					lappend edge_list $edge
				}
			}
		}
	}
}


proc set_sym_src {new_sym_src} {
	global desk cur_sym_src file_boxtag
	
	if {$cur_sym_src != "undefined"} {
		$desk itemconfigure $file_boxtag($cur_sym_src) -fill #efefef
		set cur_sym_src "undefined"
	}
	set cur_sym_src $new_sym_src
	if {$cur_sym_src != "undefined"} {
		$desk itemconfigure $file_boxtag($cur_sym_src) -fill #eecccc
	}
}


proc fill_syminfo_win {obj_file} {
	global imp_sym_lb file_imp ext_sym_lb file_ext udf_sym_lb sym_imp_file
	
	if {![winfo exists .sw]} return
	
	$imp_sym_lb delete 0 end
	$ext_sym_lb delete 0 end
	$udf_sym_lb delete 0 end
	
	foreach imp_sym $file_imp($obj_file) {
		$imp_sym_lb insert end $imp_sym
	}

	foreach ext_sym $file_ext($obj_file) {
		if {[info exists sym_imp_file($ext_sym)]} {
			$ext_sym_lb insert end $ext_sym
		} else {
			$udf_sym_lb insert end $ext_sym
		}
	}
}


proc fill_edginfo_win {src_file dst_file} {
	global edg_sym_lb file_imp file_ext 

	if {![winfo exists .ew]} return

	$edg_sym_lb delete 0 end

	foreach imp_sym $file_imp($dst_file) {
		if {[lsearch $file_ext($src_file) $imp_sym] != -1} {
			$edg_sym_lb insert end $imp_sym
		}
	}
}


proc place_edge {src_file dst_file} {
	global desk edge_list edge_tag edge_w file_xpos file_ypos edge_treshold
	global hide_x
	
	if {[lsearch $edge_list [list $src_file $dst_file]] == -1} {
		return
	}
	
	set src_x $file_xpos($src_file)
	set src_y $file_ypos($src_file)
	set src_w 60
	set src_h 20
	set dst_x $file_xpos($dst_file)
	set dst_y $file_ypos($dst_file)
	set dst_w 60
	set dst_h 20
	set dx [expr $dst_x - $src_x]
	set dy [expr $dst_y - $src_y]

	if {($src_x < $hide_x) || ($dst_x < $hide_x)} {
		$desk coords $edge_tag($src_file,$dst_file) -10 -10 -10 -10
		return
	}
	
	if {$dx > $dy} {
		if {$dx > -$dy} {
			set src_x [expr $src_x + $src_w/2]
			set dst_x [expr $dst_x - $dst_w/2]
		} else {
			set src_y [expr $src_y - $src_h/2]
			set dst_y [expr $dst_y + $dst_h/2]
		}
	} else {
		if {$dx > -$dy} {
			set src_y [expr $src_y + $src_h/2]
			set dst_y [expr $dst_y - $dst_h/2]
		} else {
			set src_x [expr $src_x - $src_w/2]
			set dst_x [expr $dst_x + $dst_w/2]
		}
	}
	set new_width [expr $edge_w($src_file,$dst_file) - $edge_treshold]
	if {$new_width < 1} {
		$desk coords $edge_tag($src_file,$dst_file) -10 -10 -10 -10
	} else {
		$desk coords $edge_tag($src_file,$dst_file) $src_x $src_y $dst_x $dst_y
		$desk itemconfigure $edge_tag($src_file,$dst_file) -width $new_width
	}
}


proc create_connections {} {
	global desk edge_list edge_tag edge_w 
	
	foreach edge $edge_list {
		set src_file [lindex $edge 0]
		set dst_file [lindex $edge 1]
		set edge_tag($src_file,$dst_file) [$desk create line 0 0 0 0 \
			-arrow last -fill #777777 -arrowshape [list 10 20 10]]
		$desk bind $edge_tag($src_file,$dst_file) <Button> "select_edge $src_file $dst_file"
		place_edge $src_file $dst_file
	}
}




#
# SCAN OBJECTS FOR IMPLEMENTED SYMBOLS AND EXTERNAL REFERENCES
#

foreach obj_file $argv {
		
	set nm_list [split [exec $nm -g --defined-only $obj_file] "\n"]
	set imp_symlist {}
	foreach sym $nm_list {
		if {([lindex $sym 1] == "T") || ([lindex $sym 1] == "D")} {
			set sym_name [lindex $sym 2]
			lappend imp_symlist $sym_name
			lappend sym_imp_file($sym_name) $obj_file
		}
	}
	set file_imp($obj_file) $imp_symlist
	
	set nm_list [split [exec $nm -P --undefined-only $obj_file] "\n"]
	set ext_symlist {}
	foreach sym $nm_list {
		set sym_name [lindex $sym 0]
		lappend ext_symlist $sym_name
		lappend sym_ext_file($sym_name) $obj_file
	}
	set file_ext($obj_file) $ext_symlist
	lappend obj_files $obj_file
}


proc set_hide_xpos {new_hide_xpos} {
	global desk hide_x edge_list mov_tag hid_tag
	set hide_x $new_hide_xpos
	$desk coords $mov_tag $hide_x 0 [expr $hide_x + 3] 5000
	$desk coords $hid_tag 0 0 $hide_x 5000
	foreach edge $edge_list {
		place_edge [lindex $edge 0] [lindex $edge 1]
	}
}

proc save_state {} {
	global obj_files file_xpos file_ypos hide_x
	
	set filename [tk_getSaveFile -filetypes {{"ObjDive data" .dve}}]
	if {$filename == ""} return
	if {![string match {*.dve} $filename]} {append filename ".dve"}
	set fh [open $filename "w+"]
	foreach obj_file $obj_files {
		puts $fh [list node_pos $obj_file $file_xpos($obj_file) $file_ypos($obj_file)]
	}
	puts $fh [list hide_xpos $hide_x]
	close $fh
}

proc save_postscript {} {
	global obj_files file_xpos file_ypos hide_x desk sel_tag
	global selbox_x1 selbox_y1 selbox_x2 selbox_y2
	
	set filename [tk_getSaveFile -filetypes {{"PostScript" .ps}}]
	if {$filename == ""} return
	if {![string match {*.ps} $filename]} {append filename ".ps"}

	$desk itemconfigure $sel_tag -fill #ccccaa
	if {($selbox_x1 == $selbox_x2) && ($selbox_y1 == $selbox_y2)} {
		$desk postscript -fontmap fontMap -colormap -colorMap -file $filename
	} else {
		set selbox_w [expr $selbox_x2 - $selbox_x1]
		set selbox_h [expr $selbox_y2 - $selbox_y1]
		$desk postscript -x $selbox_x1 -y $selbox_y1 -width $selbox_w -height $selbox_h \
		                 -fontmap fontMap -colormap -colorMap -file $filename
		
	}
	$desk itemconfigure $sel_tag -fill #bbbb77
}

proc save_dot {} {
	global obj_files edge_list
	
	set filename [tk_getSaveFile -filetypes {{"ObjDive data" .dot}}]
	if {$filename == ""} return
	if {![string match {*.dot} $filename]} {append filename ".dot"}
	set fh [open $filename "w+"]
	puts $fh "digraph objdive {"
	foreach obj_file $obj_files {
		puts $fh "  \"$obj_file\""
	}
	foreach edge $edge_list {
		set src_file [lindex $edge 0]
		set dst_file [lindex $edge 1]
		puts $fh "  \"$src_file\" -> \"$dst_file\""
	}
	puts $fh "}"
	close $fh

}

proc load_state {} {
	global file_xpos file_ypos edge_list sel_tag desk
	
	set filename [tk_getOpenFile -filetypes {{"ObjDive data" .dve}}]
	set fh [open $filename "r"]
	while {![eof $fh]} {
		set par [gets $fh]
		set par_type [lindex $par 0]
		if {$par_type == "node_pos"} {
			catch {
				move_node [lindex $par 2] [lindex $par 3] [lindex $par 1]
			}
		}
		if {$par_type == "hide_xpos"} {
			set_hide_xpos [lindex $par 1]
		}
	}
	$desk coords $sel_tag -10 -10 -10 -10
}


option add *Label*font {Helvetica -12}
option add *close*background #99aabb
option add *Scale*borderWidth 1

#
# CREATE MAIN WINDOW
#

frame .mf -relief raised -borderwidth 2

menubutton .mf.file -text "File" -menu .mf.file.menu
set filemenu [menu .mf.file.menu -tearoff 1]
$filemenu add command -label "Open..." -command load_state
$filemenu add command -label "Save..." -command save_state
$filemenu add command -label "Save as Postscript..." -command save_postscript
$filemenu add command -label "Save as Dot..." -command save_dot
$filemenu add command -label "Exit" -command exit
pack .mf.file -side left

menubutton .mf.win -text "Windows" -menu .mf.win.menu
set winmenu [menu .mf.win.menu -tearoff 1]
$winmenu add command -label "Node Information" -command create_syminfo_win
$winmenu add command -label "Edge Information" -command create_edginfo_win
pack .mf.win -side left

menubutton .mf.tool -text "Tools" -menu .mf.tool.menu
set toolmenu [menu .mf.tool.menu -tearoff 1]
$toolmenu add command -label "Random placement" -command random_nodes
pack .mf.tool -side left

menubutton .mf.help -text "?" -menu .mf.help.menu
set helpmenu [menu .mf.help.menu ]
$helpmenu add command -label "About" -command create_about_win
pack .mf.help -side right

pack .mf -fill x

set cur_sel_node "undefined"
set cur_sel_edge "undefined"
set cur_sym_src  "undefined"
set selbox_x1 -10
set selbox_y1 -10
set selbox_x2 -10
set selbox_y2 -10
set sel_nodes {}
set cur_mx -10
set cur_my -10
set max_edge_w 0
set desk [canvas .c -width $init_width -height $init_height]
set hide_cols 2
set hide_x [expr $hide_cols * 60 + 40]
set dbg_tag [$desk create rectangle 0 0 5000 5000 -fill #bbbec9]
set hid_tag [$desk create rectangle 0 0 [expr $hide_x] 5000 -fill #aaaeb9]
set sel_tag [$desk create rectangle -10 -10 -10 -10 -fill #bbbb77 -outline #bbbb00]
set mov_tag [$desk create rectangle $hide_x 0 [expr $hide_x + 3] 5000 -fill #ffffff]
$desk bind $mov_tag <B1-Motion> {set_hide_xpos %x}

init_nodes $hide_cols
init_connections

$desk bind $dbg_tag <Button> {
	set sel_flag 1
	set selbox_x1 %x
	set selbox_y1 %y
	set selbox_x2 %x
	set selbox_y2 %y
	$desk coords $sel_tag -10 -10 -10 -10
}

$desk bind $dbg_tag <B1-Motion> {
	if {$sel_flag != 1} return
	set selbox_x2 %x
	set selbox_y2 %y
	$desk coords $sel_tag $selbox_x1 $selbox_y1 $selbox_x2 $selbox_y2
}

$desk bind $dbg_tag <ButtonRelease> {
	if {$selbox_x1 > $selbox_x2} {
		set dummy $selbox_x1
		set selbox_x1 $selbox_x2
		set selbox_x2 $dummy
	}
	if {$selbox_y1 > $selbox_y2} {
		set dummy $selbox_y1
		set selbox_y1 $selbox_y2
		set selbox_y2 $dummy
	}
}

$desk bind $sel_tag <ButtonPress> {
	set cur_mx %x
	set cur_my %y
	set sel_nodes {}
	foreach obj_file $obj_files {
		set fxpos $file_xpos($obj_file)
		set fypos $file_ypos($obj_file)
		if {($fxpos > $selbox_x1) && ($fxpos < $selbox_x2) &&
			($fypos > $selbox_y1) && ($fypos < $selbox_y2)} {
			lappend sel_nodes $obj_file
		}
	}
}

$desk bind $sel_tag <B1-Motion> {
	set new_mx %x
	set new_my %y
	set dx [expr $new_mx - $cur_mx]
	set dy [expr $new_my - $cur_my]
	set selbox_x1 [expr $selbox_x1 + $dx]
	set selbox_y1 [expr $selbox_y1 + $dy]
	set selbox_x2 [expr $selbox_x2 + $dx]
	set selbox_y2 [expr $selbox_y2 + $dy]
	$desk coords $sel_tag $selbox_x1 $selbox_y1 $selbox_x2 $selbox_y2
	set cur_mx $new_mx
	set cur_my $new_my
	foreach obj_file $sel_nodes {
		set fxpos $file_xpos($obj_file)
		set fypos $file_ypos($obj_file)
		move_node [expr $fxpos+$dx] [expr $fypos+$dy] $obj_file
	}
}

bind $desk <ButtonRelease> {
	set sel_flag 0
}

pack $desk -fill both -expand yes
scale .ts -orient horizontal -from 0 -to $max_edge_w -variable edge_treshold \
			-borderwidth 2 -relief raised
bind .ts <ButtonRelease> {
	foreach edge $edge_list {
		place_edge [lindex $edge 0] [lindex $edge 1]
	}
}

pack .ts -fill x -expand no

set edge_treshold 0

create_connections
draw_nodes


#
# CREATE SYMBOL INFO WINDOW
#

proc show_sym_src {src_file symbol} {
	global portnum
	set sh [socket localhost $portnum]
	puts $sh "\033:e! [pwd]/$src_file"
#	puts $sh ":e [pwd]/$src_file"
	close $sh
	set sh [socket localhost $portnum]
	puts $sh "/$symbol"
	close $sh
}

proc create_syminfo_win {} {
	global imp_sym_lb ext_sym_lb udf_sym_lb cur_sel_node
	if {[winfo exists .sw]} return
	
	toplevel .sw 
	wm title .sw "Node Information"
	
	frame .sw.isf
	frame .sw.esf
	frame .sw.usf
	
	set imp_sym_lb [listbox .sw.isf.lb -yscrollcommand {.sw.isf.sb set} -font {Courier -10}]
	set ext_sym_lb [listbox .sw.esf.lb -yscrollcommand {.sw.esf.sb set} -font {Courier -10}]
	set udf_sym_lb [listbox .sw.usf.lb -yscrollcommand {.sw.usf.sb set} -font {Courier -10}]
	
	scrollbar .sw.isf.sb -command {.sw.isf.lb yview} 
	scrollbar .sw.esf.sb -command {.sw.esf.lb yview}
	scrollbar .sw.usf.sb -command {.sw.usf.lb yview}
	
	pack $imp_sym_lb -side left -expand yes -fill both
	pack .sw.isf.sb -side right -fill y
	
	pack $ext_sym_lb -side left -expand yes -fill both
	pack .sw.esf.sb -side right -fill y
	
	pack $udf_sym_lb -side left -expand yes -fill both
	pack .sw.usf.sb -side right -fill y
	
	pack [label .sw.ist -text "Implemented Symbols"]
	pack .sw.isf -expand yes -fill both
	pack [label .sw.est -text "External Symbols"]
	pack .sw.esf -expand yes -fill both
	pack [label .sw.ust -text "Undefined Symbols"]
	pack .sw.usf -expand yes -fill both
	pack [button .sw.close -text "Close" -command {destroy .sw}]

	bind $ext_sym_lb <ButtonRelease> {
		catch {
			set_sym_src $sym_imp_file([$ext_sym_lb get [$ext_sym_lb curselection]])
		}
	}
	bind $imp_sym_lb <ButtonRelease> {
		catch {
			set symbol [$imp_sym_lb get [$imp_sym_lb curselection]]
			set obj_file [lindex $sym_imp_file($symbol) 0]
			set src_file [lindex [split $obj_file {.}] 0]
			show_sym_src "$src_file.c" $symbol
		}
	}
	bind $udf_sym_lb <ButtonRelease> {
		catch {
			set symbol [$udf_sym_lb get [$udf_sym_lb curselection]]
			set obj_file $cur_sel_node
			set src_file [lindex [split $obj_file {.}] 0]
			show_sym_src "$src_file.c" $symbol
		}
	}

	if {$cur_sel_node != "undefined"} {
		fill_syminfo_win $cur_sel_node
	}
}

proc create_edginfo_win {} {
	global edg_sym_lb 
	if {[winfo exists .ew]} return
	toplevel .ew 
	wm title .ew "Edge Information"
	
	frame .ew.sf
	set edg_sym_lb [listbox .ew.sf.lb -yscrollcommand {.ew.sf.sb set} -font {Courier -10}]
	scrollbar .ew.sf.sb -command {.ew.sf.lb yview} 
	pack $edg_sym_lb -side left -expand yes -fill both
	pack .ew.sf.sb -side right -fill y
	pack [label .ew.st -text "Interface Symbols"]
	pack .ew.sf -expand yes -fill both
	pack [button .ew.close -text "Close" -command {destroy .ew}]
	
	bind $edg_sym_lb <ButtonRelease> {
		catch {
			set symbol [$edg_sym_lb get [$edg_sym_lb curselection]]
			set obj_file [lindex $cur_sel_edge 0]
			set src_file [lindex [split $obj_file {.}] 0]
			show_sym_src "$src_file.c" $symbol
		}
	}
}

proc create_about_win {} {
	if {[winfo exists .aw]} return
	toplevel .aw 
	wm title .aw "About ObjDive"
	
	frame .aw.f -borderwidth 2 -relief raised
	pack [label .aw.f.l1 -text "-+|\[ ObjDive \]|+- " -font {Courier -20 bold}]
	pack [label .aw.f.l2 -text "programmed by Norman Feske"]
	pack [label .aw.f.l3 -text "no@atari.org"]
	pack .aw.f -expand yes -fill both
	pack [button .aw.close -text "Close" -command {destroy .aw}]
}

create_syminfo_win
create_edginfo_win

