#!/bin/sh
# run wish \
exec wish $0 "$@"

#############################################################################
# Visual Tcl v1.11p1 Project
#

#################################
# GLOBAL VARIABLES
#
global pre_7_1_server; 
global ps_args; 
global ps_cmd_col; 
global ps_pid_param; 
global ps_pre_cmd_params; 
global ps_user; 
global ps_user_arg; 
global ps_user_end; 
global refresh_id; 
global refresh_interval; 
global sort_param; 
global sort_order; 
global sort_type; 
global awk;
global widget; 

#################################
# USER DEFINED PROCEDURES
#
proc init {argc argv} {

}

init $argc $argv


proc {about} {} {
tk_messageBox -type ok -message "pgmonitor - PostgreSQL session monitor
Version 0.28

ftp://candle.pha.pa.us/pub/postgresql/pgmonitor.tcl

Right-click on an item for help."
}

proc {adjust_refresh_setting} {click} {
global refresh_interval;

	if {$refresh_interval >= 1 || $click < 1} {
		set refresh_interval [expr $refresh_interval - $click]
	}
	list after 500 show_backends .top
}

proc {show_sort_options} {popup} {
if [winfo exists $popup] {
		wm deiconify $popup
	} else {
		Window show $popup
	}
}

proc {save_options} {} {
global refresh_interval; 
global sort_param; 
global sort_order; 
global sort_type; 
global env
	# load defaults from user's home directory .pgmonitor file
	if {![catch {open "$env(HOME)/.pgmonitor" w} fileid]} {
		puts $fileid 1
		puts $fileid $refresh_interval
		puts $fileid $sort_param
		puts $fileid $sort_order
		puts $fileid $sort_type
		close $fileid
	}
}

proc {send_signal} {base signal} {
global ps_pid_param;

	# find selected process id
	if {[catch {set cur_selection [$base.listboxscroll.border.list get [$base.listboxscroll.border.list curselection]]}]} {
		tk_messageBox -type ok -message "No process selected."
		return
	}

	set selection_pid [lindex [split [exec  echo "[string trim $cur_selection]" | sed "s/  */ /g" ] " " ] $ps_pid_param ]

	# send the signal
	if {[catch {exec kill -$signal $selection_pid} err]} {
		if {[string match "*permit*" $err]} {
			tk_messageBox -type ok -message "No permission."
			return
		} elseif {[string match "*No such process*" $err]} {
			tk_messageBox -type ok -message "Process no longer exists."
			return
		} else {
			tk_messageBox -type ok -message $err
			return
		}
	}
	# update display
	list after 500 show_backends $base
}


proc {show_query} {base popup} {
global ps_pid_param;
global pre_7_1_server;

	# find selected process id
	if {[catch {set cur_selection [$base.listboxscroll.border.list get [$base.listboxscroll.border.list curselection]]}]} {
		tk_messageBox -type ok -message "No process selected."
		return
	}

	set selection_pid [lindex [split [exec  echo "[string trim $cur_selection]" | sed "s/  */ /g" ] " " ] $ps_pid_param ]

	# clear old contents
	$popup.listboxscroll.border.list delete 0 [expr [$popup.listboxscroll.border.list size] - 1]

	# do we have kill() permission.  Easy way to check.
	if {[catch {exec kill -0 $selection_pid} err]} {
		if {[string match "*permit*" $err]} {
			tk_messageBox -type ok -message "No permission."
			return
		} elseif {[string match "*No such process*" $err]} {
			tk_messageBox -type ok -message "Process no longer exists."
			return
		} else {
			tk_messageBox -type ok -message $err
			return
		}
	}

	# connect via gdb and get query string
	if {$pre_7_1_server != "Y"} {
		set gdb_out [exec echo "set print elements 0\nprint (char *)debug_query_string\nquit\n" | sh -c "gdb -q -x /dev/stdin postgres $selection_pid 2>&1;exit 0" ]
		if {[string match "*No symbol table*" $gdb_out] ||
		    [string match "*no debugging symbols*" $gdb_out]} {
			tk_messageBox -type ok -message "Postgres pre-7.1.1 executables must have a patch applied or be compiled with debug symbols to use this feature."
			return
		}
		if {[string match "*No symbol \"*" $gdb_out]} {
			set pre_7_1_server "Y"
		}
	}
	if {$pre_7_1_server == "Y"} {
		set gdb_out [exec echo "set print elements 0\nprint pg_exec_query_string::query_string\nquit\n" | sh -c "gdb -q -x /dev/stdin postgres $selection_pid 2>&1;exit 0" ]
	}

	# interpret gdb output
	if {[string match "*\$1 = 0x0*" $gdb_out] ||
	    [string match "*No frame*" $gdb_out]} {
		tk_messageBox -type ok -message "No query being executed."
		return
	} elseif {[string match "* permit*" $gdb_out]} {
		tk_messageBox -type ok -message "No permission."
		return
	} else {
		# success, popup query window
		if [winfo exists $popup] {
			wm deiconify $popup
		} else {
			Window show $popup
		}
		set query [exec echo "$gdb_out" | grep "\\\$1" |  sed "s/\^\[\^\"\]*\"//" |  sed "s/\"\$//" | sed "s/\\\\n/\\\n/g"]
		eval {$popup.listboxscroll.border.list insert 0} [split $query "\n" ]
	}
}

proc {show_backends} {base} {
global ps_args;
global ps_pid_param;
global ps_user;
global ps_user_arg;
global ps_user_end;
global ps_cmd_col;
global refresh_id;
global refresh_interval;
global sort_param;
global sort_order;
global sort_type;
global ps_pre_cmd_params;
global awk;

	set ps_out ""

	# so 'ps', remove user column, non-backend lines, and sort
	if [catch {set ps_out [split [exec /bin/ps $ps_args$ps_user_arg $ps_user |  cut -c$ps_user_end-255 |  sed -n "2,\$p" |  $awk "
	{
		cmd=substr(\$0,$ps_cmd_col);
		gsub(\"\\\\(\[\^\\\\)\]*\\\\)\",\"\",cmd); # remove entries around parens, (), *BSD
		gsub(\"\^\[\^:\]*:\",\"\",cmd);		# remove command with colon, cmd:, Linux
		split(cmd,cmd_split);			# split up db-supplied info	
		# <7.1 had bug where fields were swapped on some platforms
		if (cmd_split\[2\] ~ /\^\[0-9\]\[0-9\]*\\.\[0-9\]\[0-9\]*\\.\[0-9\]|\^\\\[local\\\]/)
		{
			tmp = cmd_split\[2\];
			cmd_split\[2\] = cmd_split\[3\];
			cmd_split\[3\] = tmp;
		}
		if (cmd_split\[4\] != \"\" &&		# must have at least four params and connect info
		    cmd_split\[3\] ~ /\^\[0-9\]\[0-9\]*\\.\[0-9\]\[0-9\]*\\.\[0-9\]|\^\\\[local\\\]/)
		{
			# prefix line with sorted field
			if ($sort_param < $ps_pre_cmd_params)
				printf \"%s\^\", \$[expr $sort_param + 1];
			else	printf \"%s\^\", cmd_split\[[expr $sort_param + 1 - $ps_pre_cmd_params]\];
			# print full process detail line
			printf \"%s %-10.10s%-10.10s%-17s %-s %-s %-s\\n\",  
				substr(\$0,1,[expr $ps_cmd_col - 1]),  
				cmd_split\[1\],cmd_split\[2\],cmd_split\[3\],
				cmd_split\[4\],cmd_split\[5\],cmd_split\[6\];
		}
		# sort by sorted column, then strip it off
	}" | sort -t "\^" -$sort_order$sort_type | cut -d "\^" -f2 ] "\n" ]} err] {
	    error "ps failed: $err"
	}

	# get pid of current selection
	set cur_selection ""
	catch {set cur_selection [$base.listboxscroll.border.list get [$base.listboxscroll.border.list curselection]]}
	set selection_pid [lindex [split [exec  echo "[string trim $cur_selection]" | sed "s/  */ /g" ] " " ] $ps_pid_param ]

	#load up the listbox
	$base.listboxscroll.border.list delete 0 [expr [$base.listboxscroll.border.list size] - 1]
	eval {$base.listboxscroll.border.list insert 0} $ps_out

	# restore pid selection
	set i 0
	foreach ps_line $ps_out {
		set cur_pid [lindex [split [exec  echo "[string trim $ps_line]" | sed "s/  */ /g" ] " " ] $ps_pid_param ]
		if {$selection_pid == $cur_pid} {
		      $base.listboxscroll.border.list selection set $i
		      break
		}
	       incr i
	}

	# if we were called by the Refresh button, cancel old timeout
	catch {after cancel $refresh_id}

	# reschedule ourselves
	if {$refresh_interval >= 1} {
		set i [expr $refresh_interval * 1000]
	} else	{
		set i 100
	}
	set refresh_id [after $i show_backends $base]
}

proc {widget_init} {argc argv base} {
global ps_args;
global ps_all_arg;
global ps_user_arg;
global ps_pid_arg;

global ps_pid_param;
global ps_user;
global ps_user_end;
global ps_cmd_col;
global ps_heading;

global refresh_interval;
global pre_7_1_server;
global sort_param;
global sort_order;
global sort_type;
global ps_pre_cmd_params;
global awk;
global env;

	if {$base == ""} {
        	set base .
	}

	# find awk version that supports gsub()
	if {![catch {exec echo | awk "{gsub(\".\",\"\")}"}]} {
		set awk "awk"
	} elseif {![catch {exec echo | nawk "{gsub(\".\",\"\")}"}]} {
		set awk "nawk"
	} elseif {![catch {exec echo | gawk "{gsub(\".\",\"\")}"}]} {
		set awk "gawk"
	} else {
		error "Can't find awk version that supports gsub()"
	}

	# BSD-style ps arguments mean:
	#	a display other users's processes too
	#	u display user information
	#	w 132 column display
	#	w another 'w' means display as wide as needed, no limit
	set ps_args "auww"
	#	x show processes with no controlling terminal
	set ps_all_arg "x"
	#	U show only certain users processes
	set ps_user_arg	"U"
	#	p show pid
	set ps_pid_arg "p"

	if {[catch {try_ps_args $argc $argv} msg]} {
		# try SysV-style ps flags:
	  	#	f display full listing, needs dash
		set ps_args "-f"
		#	e display all processes
		set ps_all_arg "e"
		#	u show only certain users processes
		set ps_user_arg	"u"
		#	p show pid
		set ps_pid_arg "p"

		if {[catch {try_ps_args $argc $argv} msg]} {
		    error "Can't run 'ps'\nPlease send in a patch."
		}
	}

	# load the heading
	$base.listboxscroll.border.heading insert 0  $ps_heading

	# set defaults
	set pre_7_1_server "N"
	set sort_param "${ps_pid_param}"
	set sort_order ""
	set sort_type "n"

	# load defaults from user's home directory .pgmonitor file
	if {![catch {open "$env(HOME)/.pgmonitor" r} fileid]} {
		if {![catch {gets $fileid} pgmonitor_version]} {
			if {$pgmonitor_version == 1} {
				catch {set refresh_interval [gets $fileid]}
				catch {set sort_param [gets $fileid]}
				catch {set sort_order [gets $fileid]}
				catch {set sort_type [gets $fileid]}
			}
		}
		close $fileid
	}
		   		
	# load sort options window with ps column headings
	set i 0
	foreach col [split [exec echo "[string trim $ps_heading]" | sed "s/  */ /g"] " "] {
		radiobutton .sort_options.column.col_$i  -background #ecf0a4 -highlightthickness 0  -text $col -value $i -variable sort_param
		pack .sort_options.column.col_$i  -in .sort_options.column  -anchor w -expand 0 -fill none  -side top
		incr i
	}
	set ps_pre_cmd_params [expr $i - 4]

	# load backends
	show_backends $base

	# keyboard defaults

	bind all <Control-c> {destroy .}

	bind . <Destroy> {save_options}

	focus $base.listboxscroll.border.list
	wm withdraw .query_popup
	wm withdraw .sort_options
}

proc {try_ps_args} {argc argv} {
global ps_args;
global ps_all_arg;
global ps_user_arg;
global ps_pid_arg;

global ps_pid_param;
global ps_user;
global ps_user_end;
global ps_cmd_col;
global ps_heading;
global awk;
global env;

	# This proc either validates the ps_args, ps_all_arg, ps_user_arg,
	# ps_pid_arg values, or throws an error.  If successful, derived
	# information is stored into ps_pid_param and other globals.

	# get USER column parameter number
	set ps_heading_user [split [string trim [exec  /bin/ps $ps_args$ps_pid_arg 1 2>/dev/null |  sed -n "1p" |  sed "s/  */ /g" ]] " " ]
	set ps_user_param -1
	set i 0
	foreach col $ps_heading_user {
		if {[lindex $ps_heading_user $i] == "USER" ||
			[lindex $ps_heading_user $i] == "UID"} {
			set ps_user_param $i
			break
		}
		incr i
	}
	if {$ps_user_param == -1} {
		error "Can't find USER column heading"
	}

	# check other columns before we test for postmaster and
	# and process arg columns
	if {![string match "*PID*" $ps_heading_user]} {
		error "Can't find PID column heading"
	}
	if {![string match "*COMMAND*" $ps_heading_user] &&
	    ![string match "*CMD*" $ps_heading_user]} {
		error "Can't find COMMAND/CMD column heading"
	}

	# get pg username, either from command line or postmaster process owner
	if {$argc>0} {
		set ps_user [lindex $argv 0]
	# try PGDATA directory ownership
	} elseif {![catch {set ps_user [exec ls -ld "$env(PGDATA)" | $awk "{print \$3}"]}]} {
	# try user name for postmaster from lock file
	} elseif {![catch {set ps_user [exec ls -l "/tmp/.s.PGSQL.5432.lock" | $awk "{print \$3}"]}]} {
	# try user name for postmaster from socket
	} elseif {![catch {set ps_user [exec ls -l "/tmp/.s.PGSQL.5432" | $awk "{print \$3}"]}]} {
	# do expensive full 'ps'
	} else {
		puts stderr "Can't find the username of the PostgreSQL server.\nEither start the postmaster, define PGDATA, or\nsupply the username on the command line."
		exit 1
	}

	# get end of user column so it can be clipped off
	if {$ps_user_param == 0} {
		set ps_user_end [expr [string length $ps_user] + 1]
	} else {
		set ps_user_end 1
	}

	# get PID column parameter number
	set ps_heading_nouser [split [string trim [exec /bin/ps $ps_args$ps_pid_arg 1 | sed -n "1p" | cut -c$ps_user_end-255 | sed "s/  */ /g" ]] " " ]
	set ps_pid_param -1
	set i 0
	foreach col $ps_heading_nouser {
		if {[lindex $ps_heading_nouser $i] == "PID"} {
			set ps_pid_param $i
			break
		}
		incr i
	}
	if {$ps_pid_param == -1} {
		puts stderr "Can't find PID column heading"
		exit 1
	}

	# get a new heading without the user column
	set ps_heading [exec /bin/ps $ps_args$ps_user_arg $ps_user | sed -n "1p" | cut -c$ps_user_end-255]

	# find the column of the COMMAND/CMD
	if {[string first "COMMAND" $ps_heading] != -1} {
		set ps_cmd_col [string first "COMMAND" $ps_heading]
	} elseif {[string first "CMD" $ps_heading] != -1} {
		set ps_cmd_col [string first "CMD" $ps_heading]
	} else {
		puts stderr "Can't find COMMAND/CMD column heading"
		exit 1
	}

	# adjust heading to be the way we want it
	set ps_heading [exec echo "$ps_heading" |  $awk "\{
		printf \"%s %-10.10s%-10.10s%-17s %-s\\n\",  
		substr(\$0,1,[expr $ps_cmd_col - 1]),  
		\"USER\", \"DATABASE\", \"CONNECTION\", \"QUERY\"
	\}" ]
}

proc {main} {argc argv} {
widget_init $argc $argv .top
}

proc {Window} {args} {
global vTcl
    set cmd [lindex $args 0]
    set name [lindex $args 1]
    set newname [lindex $args 2]
    set rest [lrange $args 3 end]
    if {$name == "" || $cmd == ""} {return}
    if {$newname == ""} {
        set newname $name
    }
    set exists [winfo exists $newname]
    switch $cmd {
        show {
            if {$exists == "1" && $name != "."} {wm deiconify $name; return}
            if {[info procs vTclWindow(pre)$name] != ""} {
                eval "vTclWindow(pre)$name $newname $rest"
            }
            if {[info procs vTclWindow$name] != ""} {
                eval "vTclWindow$name $newname $rest"
            }
            if {[info procs vTclWindow(post)$name] != ""} {
                eval "vTclWindow(post)$name $newname $rest"
            }
        }
        hide    { if $exists {wm withdraw $newname; return} }
        iconify { if $exists {wm iconify $newname; return} }
        destroy { if $exists {destroy $newname; return} }
    }
}

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    wm focusmodel $base active
    wm geometry $base 200x200
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm withdraw $base
    wm title $base "vt.tcl"
    ###################
    # SETTING GEOMETRY
    ###################
}

proc vTclWindow.query_popup {base} {
    if {$base == ""} {
        set base .query_popup
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -background #c4eeec -borderwidth 2 
    wm focusmodel $base passive
    wm geometry $base 647x298
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm deiconify $base
    wm title $base "Query String"
    frame $base.listboxscroll \
        -background #c4eeec -highlightbackground #c4eeec 
    scrollbar $base.listboxscroll.xscroll \
        -activebackground #ecf0a4 -background #ecf0a4 \
        -command {.query_popup.listboxscroll.border.list xview} \
        -highlightbackground #c4eeec -highlightthickness 0 -orient horizontal \
        -takefocus 0 -troughcolor #c4eeec 
    scrollbar $base.listboxscroll.yscroll \
        -activebackground #ecf0a4 -background #ecf0a4 \
        -command {.query_popup.listboxscroll.border.list yview} \
        -highlightbackground #c4eeec -highlightthickness 0 -takefocus 0 \
        -troughcolor #c4eeec 
    frame $base.listboxscroll.border \
        -background #ecf0a4 -borderwidth 4 -highlightbackground #c4eeec \
        -relief sunken 
    listbox $base.listboxscroll.border.list \
        -background #ecf0a4 -borderwidth 0 -font {Fixed -12 bold} -height 1 \
        -highlightbackground #e8dc4c -highlightthickness 0 -relief flat \
        -selectbackground #dade4a -takefocus 1 -width 1 \
        -xscrollcommand {.query_popup.listboxscroll.xscroll set} \
        -yscrollcommand {.query_popup.listboxscroll.yscroll set} 
    button $base.exit \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 \
        -command {wm withdraw .query_popup} -padx 9 -pady 3 -takefocus 1 \
        -text Close 
    ###################
    # SETTING GEOMETRY
    ###################
    pack $base.listboxscroll \
        -in .query_popup -anchor center -expand 1 -fill both -side top 
    pack $base.listboxscroll.xscroll \
        -in .query_popup.listboxscroll -anchor center -expand 0 -fill x \
        -side bottom 
    pack $base.listboxscroll.yscroll \
        -in .query_popup.listboxscroll -anchor center -expand 0 -fill y \
        -side right 
    pack $base.listboxscroll.border \
        -in .query_popup.listboxscroll -anchor center -expand 1 -fill both \
        -padx 6 -pady 6 -side top 
    pack $base.listboxscroll.border.list \
        -in .query_popup.listboxscroll.border -anchor center -expand 1 \
        -fill both -padx 5 -pady 6 -side bottom 
    pack $base.exit \
        -in .query_popup -anchor e -expand 0 -fill x -padx 5 -pady 5 \
        -side bottom 
}

proc vTclWindow.sort_options {base} {
    if {$base == ""} {
        set base .sort_options
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -background #c4eeec -borderwidth 2 
    wm focusmodel $base passive
    wm geometry $base 244x513
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm deiconify $base
    wm title $base "Sort Options"
    label $base.sort_column \
        -background #c4eeec -text Column 
    frame $base.column \
        -background #ecf0a4 -borderwidth 2 -relief sunken 
    label $base.sort_order \
        -background #c4eeec -text Order 
    frame $base.order \
        -background #ecf0a4 -borderwidth 2 -relief sunken 
    radiobutton $base.order.ascending \
        -background #ecf0a4 -highlightthickness 0 -text Ascending \
        -variable sort_order 
    radiobutton $base.order.descending \
        -background #ecf0a4 -highlightthickness 0 -text Descending -value "r" \
        -variable sort_order 
    label $base.sort_type \
        -background #c4eeec -text Type 
    frame $base.type \
        -background #ecf0a4 -borderwidth 2 -relief sunken 
    radiobutton $base.type.numeric \
        -background #ecf0a4 -highlightthickness 0 -text Numeric -value "n" \
        -variable sort_type 
    radiobutton $base.type.alphabetic \
        -background #ecf0a4 -highlightthickness 0 -text Alphabetic \
        -variable sort_type 
    button $base.exit \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 \
        -command {wm withdraw .sort_options} -padx 9 -pady 3 -takefocus 1 \
        -text Close 
    ###################
    # SETTING GEOMETRY
    ###################
    pack $base.sort_column \
        -in .sort_options -anchor w -expand 1 -fill both -side top 
    pack $base.column \
        -in .sort_options -anchor w -expand 1 -fill x -side top 
    pack $base.sort_order \
        -in .sort_options -anchor w -expand 1 -fill both -side top 
    pack $base.order \
        -in .sort_options -anchor w -expand 1 -fill x -side top 
    pack $base.order.ascending \
        -in .sort_options.order -anchor w -expand 0 -fill none -side top 
    pack $base.order.descending \
        -in .sort_options.order -anchor w -expand 0 -fill none -side top 
    pack $base.sort_type \
        -in .sort_options -anchor w -expand 1 -fill both -side top 
    pack $base.type \
        -in .sort_options -anchor w -expand 1 -fill x -side top 
    pack $base.type.numeric \
        -in .sort_options.type -anchor w -expand 0 -fill none -side top 
    pack $base.type.alphabetic \
        -in .sort_options.type -anchor w -expand 0 -fill none -side top 
    pack $base.exit \
        -in .sort_options -anchor e -expand 0 -fill x -padx 5 -pady 5 \
        -side bottom 
}

proc vTclWindow.top {base} {
    if {$base == ""} {
        set base .top
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -background #c4eeec -borderwidth 2 
    wm focusmodel $base passive
    wm geometry $base 787x513
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm deiconify $base
    wm title $base "pgmonitor"
    frame $base.listboxscroll \
        -background #c4eeec -highlightbackground #c4eeec 
    scrollbar $base.listboxscroll.xscroll \
        -activebackground #ecf0a4 -background #ecf0a4 \
        -command {.top.listboxscroll.border.list xview} \
        -highlightbackground #c4eeec -highlightthickness 0 -orient horizontal \
        -takefocus 0 -troughcolor #c4eeec 
    scrollbar $base.listboxscroll.yscroll \
        -activebackground #ecf0a4 -background #ecf0a4 \
        -command {.top.listboxscroll.border.list yview} \
        -highlightbackground #c4eeec -highlightthickness 0 -takefocus 0 \
        -troughcolor #c4eeec 
    frame $base.listboxscroll.border \
        -background #ecf0a4 -borderwidth 4 -highlightbackground #c4eeec \
        -relief sunken 
    listbox $base.listboxscroll.border.heading \
        -background #ecf0a4 -font {Fixed -12 bold} -height 1 \
        -highlightbackground #e8dc4c -highlightthickness 0 -relief raised \
        -selectbackground #dade4a -takefocus 0 -width 1 \
        -xscrollcommand {.top.listboxscroll.xscroll set} 
    listbox $base.listboxscroll.border.list \
        -background #ecf0a4 -borderwidth 0 -font {Fixed -12 bold} -height 1 \
        -highlightbackground #e8dc4c -highlightthickness 0 -relief flat \
        -selectbackground #dade4a -takefocus 1 -width 1 \
        -xscrollcommand {.top.listboxscroll.xscroll set} \
        -yscrollcommand {.top.listboxscroll.yscroll set} 
    bind $base.listboxscroll.border.list <Double-Button-1> {
        show_query .top .query_popup
    }
    bind $base.listboxscroll.border.list <Key-Return> {
        show_query [list $base .query_popup]
    }
    frame $base.button \
        -background #c4eeec 
    button $base.button.refresh \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 \
        -command {after idle show_backends .top} -padx 9 -pady 3 -takefocus 1 \
        -text Refresh 
    bind $base.button.refresh <Button-3> {
        tk_messageBox -type ok -message "Refreshes the process listing."
    }
    scrollbar $base.button.refresh_scroll \
        -background #c4eeec -command {adjust_refresh_setting } -orient vert \
        -width 7 
    label $base.button.refresh_setting \
        -anchor e -background #c4eeec -padx 0 -pady 0 -text 5 \
        -textvariable refresh_interval -width 3 
    label $base.button.seconds \
        -anchor w -background #c4eeec -padx 0 -pady 3 -text seconds -width 7 
    button $base.button.sort \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 \
        -command {show_sort_options .sort_options} -padx 9 -pady 3 \
        -takefocus 1 -text Sort 
    bind $base.button.sort <Button-3> {
        tk_messageBox -type ok -message "Allows soring of processes."
    }
    button $base.button.query \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 \
        -command {show_query .top .query_popup} -padx 9 -pady 3 -takefocus 1 \
        -text Query 
    bind $base.button.query <Button-3> {
        tk_messageBox -type ok -message "Shows query currently executing by a process.\nDouble-clicking on a process does the same thing."
    }
    button $base.button.cancel \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 \
        -command {send_signal .top 2} -padx 9 -pady 3 -takefocus 1 \
        -text Cancel 
    bind $base.button.cancel <Button-3> {
        tk_messageBox -type ok -message "Cancels the currently running query."
    }
    button $base.button.terminate \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 \
        -command {send_signal .top 15} -padx 9 -pady 3 -takefocus 1 \
        -text Terminate 
    bind $base.button.terminate <Button-3> {
        tk_messageBox -type ok -message "Terminates the process."
    }
    button $base.button.exit \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 -command {destroy .} \
        -padx 9 -pady 3 -takefocus 1 -text Exit 
    bind $base.button.exit <Button-3> {
        tk_messageBox -type ok -message "Exits the application."
    }
    button $base.button.about \
        -foreground #ecf0a4 -activeforeground #ecf0a4 -activebackground #fe4020 -background #be4020 -command about -padx 9 \
        -pady 3 -takefocus 1 -text About 
    bind $base.button.about <Button-3> {
        tk_messageBox -type ok -message "You want help about 'about'?"
    }
    ###################
    # SETTING GEOMETRY
    ###################
    pack $base.listboxscroll \
        -in .top -anchor center -expand 1 -fill both -side top 
    pack $base.listboxscroll.xscroll \
        -in .top.listboxscroll -anchor center -expand 0 -fill x -side bottom 
    pack $base.listboxscroll.yscroll \
        -in .top.listboxscroll -anchor center -expand 0 -fill y -side right 
    pack $base.listboxscroll.border \
        -in .top.listboxscroll -anchor center -expand 1 -fill both -padx 6 \
        -pady 6 -side top 
    pack $base.listboxscroll.border.heading \
        -in .top.listboxscroll.border -anchor center -expand 0 -fill x \
        -padx 5 -pady 6 -side top 
    pack $base.listboxscroll.border.list \
        -in .top.listboxscroll.border -anchor center -expand 1 -fill both \
        -padx 5 -pady 6 -side bottom 
    pack $base.button \
        -in .top -anchor center -expand 0 -fill x -side bottom 
    pack $base.button.refresh \
        -in .top.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \
        -side left 
    pack $base.button.refresh_scroll \
        -in .top.button -anchor center -expand 0 -fill none -side left 
    pack $base.button.refresh_setting \
        -in .top.button -anchor e -expand 0 -fill none -side left 
    pack $base.button.seconds \
        -in .top.button -anchor center -expand 0 -fill none -side left 
    pack $base.button.sort \
        -in .top.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \
        -side left 
    pack $base.button.query \
        -in .top.button -anchor e -expand 1 -fill none -padx 5 -pady 5 \
        -side left 
    pack $base.button.cancel \
        -in .top.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \
        -side left 
    pack $base.button.terminate \
        -in .top.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \
        -side left 
    pack $base.button.exit \
        -in .top.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \
        -side right 
    pack $base.button.about \
        -in .top.button -anchor e -expand 1 -fill none -padx 5 -pady 5 \
        -side right 
}

Window show .
Window show .query_popup
Window show .sort_options
Window show .top

main $argc $argv
