#!/usr/bin/env wish

# WISH Command Center 2009
# (the eighth version of WISH Command Center)
# by David McClamrock <mcclamrock@locl.net>

# Copyright  2003-2008 David H. McClamrock
# Freely available under Maximum Use License for Everyone
# You should have received a copy of this license with this file.
# If you didn't, e-mail the author to get one.


##################################


### INITIALIZATION ###


# WISH applications require at least Tcl and Tk 8.5:

set tclo [package vcompare [package require Tcl] 8.5]
set tko [package vcompare [package require Tk] 8.5]
if {$tclo < 0 || $tko < 0} {
	tk_messageBox -message "This program requires Tcl and Tk 8.5 or greater" -type ok
	exit
}
package require Ttk

# Default settings:

set topdir /usr/local
set docdir [file join $topdir doc wishes]
set libdir [file join $topdir lib wishes]
set helpfile [file join $docdir comhelp_link.txt] ; # User Help Guide
set licfile [file join $docdir mule_license.txt] ; # License
set wishimg [file join $libdir wishcom.gif] ; # Logo
set version "2009"
set current_scheme AntiqueBisque

# Where program listings and configuration files go
# (Replace old "~/wishes," if any, with new "~/.wishes")

set wishdir [file join $env(HOME) .wishes]
set oldwishdir [file join $env(HOME) wishes]
if {[file exists $wishdir] == 0} {
	if {[file exists $oldwishdir] && [file type $oldwishdir] eq "directory"} {
		file rename $oldwishdir $wishdir
		file link $oldwishdir $wishdir
	} else {
		file mkdir $wishdir
	}
}
set colordir [file join $wishdir colorschemes]

# One or more features may work only on unix platforms (including Linux), 
# so identify the platform:
set platforms [split [array get tcl_platform]]
if {"unix" in $platforms} {
	set platform unix
}

# Set a few more defaults:

set proglist [list] ; # Program listings
set autolist [list] ; # Auto-Select list
set deleteds [list] ; # Previously deleted listings
set delwarn 0 ; # Don't warn before deleting listings
set coloron 0 ; # WISH Color Picker Plus not yet loaded
set helpon 0 ; # WISH User Help not yet loaded either

# Get list from old "comprog.tcl" file, if any:
set comprog [file join $wishdir comprog.tcl]
if {[file readable $comprog]} {
	source $comprog
}

# Read configuration file, if there is one:

set comfig [file join $wishdir comfig.tcl]
if {[file readable $comfig]} {
	source $comfig
}

# Procedure to save configuration:

proc savefig {} {
	global comfig
	set filid [open $comfig w]
	set figlines "# WISH Command Center configuration file (comfig.tcl)\
		\n\nset proglist \[list $::proglist\]\
		\nset autolist \[list $::autolist\]\
		\nset deleteds \[list $::deleteds\]\
		\nset current_scheme $::current_scheme"
	puts -nonewline $filid $figlines
	close $filid
}

# Initialize lists of widgets for color display
# (not all may be used by all programs):

set buttlist [list] ; # Buttons
set texlist [list] ; # Text widgets
set entlist [list] ; # Entry widgets
set lublist [list] ; # Listboxes
set spinlist [list] ; # Spinboxes
set winlist [list] ; # Widgets to get window background color when disabled
set headlist [list] ; # Emphasized labels
set lightlist [list] ; # Light labels
set checklist [list] ; # Checkbuttons and radiobuttons

# Procedure to find out whether executable program is in system's PATH or not:

proc inpath {prog} {
	global env
	set exok 0
	set envlist [split $env(PATH) :]
	foreach direc $envlist {
		if {[file executable [file join $direc $prog]]} {
			set exok 1
			break
		}
	}
	return $exok
}
	
# Integer range generator for "foreach"
# (to do a "for" loop without ugly, awkward "for" code):

proc range {start cutoff finish {step 1}} {
	# If "start" and "finish" aren't integers, do nothing:
	if {[string is integer -strict $start] == 0 || [string is\
		integer -strict $finish] == 0} {
		error"range: Rangemustcontaintwointegers"
	}
			
	# "Step" has to be an integer too, and
	# no infinite loops that go nowhere are allowed:
	if {$step == 0 || [string is integer -strict $step] == 0} {
		error "range: Step must be an integer other than zero"
	}
	
	# Does the range include the last number?
	switch $cutoff {
		"to" {set inclu 1}
		"no" {set inclu 0}
		default {
			error "range: Use \"to\" for an inclusive range,\
			or \"no\" for a noninclusive range"
		}
	}
		
	# Is the range ascending or descending (or neither)?
	set ascendo [expr $finish - $start]
	if {$ascendo > -1} {
		set up 1
	} else {
		set up 0
	}
	
	# If range is descending and step is positive but doesn't have a "+" sign,
	# change step to negative:
	if {$up == 0 && $step > 0 && [string first "+" $start] != 0} {
		set step [expr $step * -1]
	}
	
	set ranger [list] ; # Initialize list variable for generated range
	switch "$up $inclu" {
		"1 1" {set op "<=" ; # Ascending, inclusive range}
		"1 0" {set op "<" ; # Ascending, noninclusive range}
		"0 1" {set op ">=" ; # Descending, inclusive range}
		"0 0" {set op ">" ; # Descending, noninclusive range}
	}
	
	# Generate a list containing the specified range of integers:
	for {set i $start} "\$i $op $finish" {incr i $step} {
		lappend ranger $i
	}
	return $ranger
}

	
### GUI SETUP ###

wm title . "WISH Command Center"
set paddy 2
set bordo 1
set toptext "Click Run Programs, press Enter, right-click, or double\
	left-click\nto run programs; press this button for H E L P"
grid [button .help -text $toptext -command comhelp] \
	-row 0 -column 0 -columnspan 3 -sticky news
	
grid [canvas .can -height 276 -width 126] -row 1 -column 0 -sticky news
image create photo wishcom -file $wishimg
.can create image 1 1 -anchor nw -image wishcom
	
frame .fr
button .run -text "Run Programs" -command {
	progrun
	selection clear
}
button .autosel -text "Auto-Select" -command autobox
button .colodisp -text "Color Display" -command colodisp
button .add -text "Add Listing" -command "fixbox Add"
button .edit -text "Edit Listing" -command "fixbox Edit"
button .unlist -text "Delete Listing(s)" -activebackground red \
	-command unlist
button .sort -text "Sort List" -command sortlist
button .deselect -text "Deselect All" -command {selection clear}
button .kill -text "KILL" -activebackground red -command bumpoff
button .quit -text "Quit" -command exit

foreach butt [list .help .run .autoadd .autosel .colodisp .add .edit \
	.unlist .sort .deselect .kill .quit] {
	lappend buttlist $butt
}

if {$platform ne "unix"} {
	.kill configure -state disabled
}

if {[inpath xkill] == 0 && [inpath ps == 0]} {
	.kill configure -state disabled
}

pack .run .autosel .colodisp .add .edit .unlist .sort .deselect \
	.kill .quit -in .fr -side top -expand 1 -fill both
grid .fr -row 2 -column 0 -sticky news

frame .fristbox	
listbox .lb -width 50 -selectmode extended -height 35
lappend lublist .lb
ttk::scrollbar .rollzon -orient horizontal -command ".lb xview"
pack .lb .rollzon -in .fristbox -side top -expand 1 -fill both
grid .fristbox -row 1 -column 1 -rowspan 2 -sticky news
	
grid [ttk::scrollbar .rollon] -row 1 -column 2 -rowspan 2 -sticky news	
	
.lb configure -yscrollcommand ".rollon set" \
	-xscrollcommand ".rollzon set" -setgrid 1
.rollon configure -command ".lb yview"

grid columnconfigure . 2 -weight 1
grid rowconfigure . 1 -weight 1
bind . <Key-Return> {
	progrun
	selection clear
}
bind .lb <Double-Button-1> progrun
bind .lb <Button-3> {
	selection clear
	set clixel %y
	set clickline [.lb nearest $clixel]
	.lb selection set $clickline $clickline
	progrun
}


### USER HELP ###

# Use WISH User Help for user help guide:

# Procedure for setting up user help display:

proc comhelp {} {
	global helpon libdir
	if {$helpon == 0} {
		source [file join $libdir wishuhelp.tcl]
		set helpon 1
	}
	uhelp ; # Set up user help window--from WISH User Help
	wm title .uhelp "WISH Command Center - User Help"
	set linkup [open $::helpfile r]
	set helpcontents [read $linkup]
	close $linkup
	.uhelp.tx insert 1.0 $helpcontents
	helplink .uhelp.tx; # Show links in text--from WISH User Help
	.uhelp.tx mark set insert 1.0
	.uhelp.tx configure -state disabled
}


### RUN PROGRAMS ###

# Procedure to get the program list (if there is one),
# put the display names in the listboxes, and
# auto-select designated program names:

proc getlist {} {
	global wishdir proglist progfile autolist autofile
	set progleng [llength $proglist]
	foreach p [range 0 no $progleng] {
		set progline [lindex $proglist $p]
		.lb insert end [lindex $progline 0]
	}
	set autoleng [llength $autolist]
	foreach a [range 0 no $autoleng] {
		set autoline [lindex $autolist $a]
		foreach i [range 0 no [.lb index end]] {
			if {[.lb get $i] eq $autoline} {
				.lb selection set $i
				continue
			}
		}
	}
}

# Procedure to run one or more programs:
proc progrun {} {
	global proglist
	set getlines [.lb curselection]
	if {$getlines == ""} {
		tk_messageBox -message "Please select one or more\
			programs to run!"
		return
	}
	if {[llength $getlines] > 12} {
		set runornot [tk_messageBox -message "Are you sure you want\
			to run that many programs at once?" -type yesno]
		if {$runornot != "yes"} {
			return
		}
	}
	foreach runline $getlines {
		set thisisit [.lb get $runline]
		foreach item $proglist {
			# Is display name selected? If so, extract official name:
			if {[string equal [lindex $item 0] $thisisit]} {
				set boglisto [split [lindex $item 1]]
				set commando [lindex $boglisto 0]
				# And use "eval" or "eval exec" with args:
				if {$commando == "wishcom" || [info commands $commando] < 1} {
					set mandatum "exec [lindex $item 1] &"
				} else {
					set mandatum [lindex $item 1]
				}
				# Run program, or get error message:
				set isitbad [catch {eval $mandatum} bogosity]
				if {$isitbad == 1} {
					tk_messageBox -message $bogosity -type ok
				}
			}
		}
	}
}


### AUTO-ADD ###

# Procedure to get program listings and add them automatically:

proc autoadd {} {
	global proglist libdir allprogs deleteds
	set oldprogleng [llength $proglist]
	set allprogfile [file join $libdir allprogs.tcl]
	if {[file readable $allprogfile]} {
		source $allprogfile
		foreach prog $allprogs {
			set progdisp [lindex $prog 0]
			set prognom [lindex $prog end 0]
			if {[inpath $prognom]} {
				set isaprog [lsearch -index end $proglist $prognom]
				if {[info exists deleteds]} {
					set isadel [lsearch $deleteds $progdisp]
				} else {
					set isadel "-1"
				}
				if {$isaprog < 0 && $isadel < 0} {
					lappend proglist [list $progdisp $prognom]
					.lb insert end $progdisp
				}
			}
		}
		if {[llength $proglist] > $oldprogleng} {
			tk_messageBox -message "All installed programs listed in the file\
				\"$allprogfile,\"	except previously listed or deleted programs,\
				have been	added to end of list. Delete any unwanted listings;\
				then click	\"Sort List\" to alphabetize listings" -type ok
		}
	}
	if {[info exists allprogs]} {
		unset allprogs
	}
	savefig
}


### AUTO-SELECT ###

# Get Auto-Select list:
set autofile [file join $wishdir comauto.tcl]

# Procedure to set up box to add or remove
# program listings from Auto-Select list:

proc autobox {} {
	global autolist autofile oldautolist wishdir
	set oldautolist [list]
	toplevel .auto
	wm title .auto "Auto-Select"
	grid [label .auto.toadd -text "To add programs\
		to \"auto-select\" list:"] -sticky news
	grid [label .auto.toady -text "select program names and\
		click \"Add to List\""] -sticky news
	frame .auto.lub
	listbox .auto.sel -height 12 -width 40 -selectmode extended \
		-listvariable autolist -bg $::textback -fg $::textfore
	ttk::scrollbar .auto.roll -command ".auto.sel yview"
	.auto.sel configure -yscrollcommand ".auto.roll set"
	pack .auto.sel .auto.roll -in .auto.lub -side left -expand 1 -fill both
	grid .auto.lub -sticky news
	frame .auto.fr
	button .auto.add -text "Add to List" -default normal -command autoseladd
	button .auto.del -text "Unlist" -default normal -command autounlist
	button .auto.done -text "Done" -default normal -relief solid -command {
		savefig
		destroy .auto
	}
	button .auto.close -text "Close" -default normal -command {
		destroy .auto
	}
	foreach butt [list .auto.add .auto.del .auto.done .auto.close] {
		$butt configure -bg $::buttback -fg $::buttfore
	}
	pack .auto.add .auto.del .auto.done .auto.close -in .auto.fr\
		-side left -expand 1 -fill both
	grid .auto.fr -sticky news
	set oldautolist [list]
	bind .auto <Key-Return> {
		savefig
		destroy .auto
	}
}

# Procedure to add items to Auto-Select list:

proc autoseladd {} {
	global autolist
	set adders [.lb curselection]
	set adderleng [llength $adders]
	foreach a [range 0 no $adderleng] {
		set addline [.lb get [lindex $adders $a]]
		if {[lsearch $autolist $addline] < 0} {
			lappend autolist $addline
		}
	}
	savefig
}

# Procedure to delete items from Auto-Select list:

proc autounlist {} {
	global autolist
	set unlisters [.auto.sel curselection]
	set unleng [expr [llength $unlisters] -1]
	foreach a [range $unleng to 0] {
		set unline [lindex $unlisters $a]
		set autolist [lreplace $autolist $unline $unline]
	}
	savefig
}



### COLOR DISPLAY ###

# Procedure to set up GUI box for configuring color display:

proc colodisp {} {
	global color red green blue whatfig whatbutt colorlist colordir \
		winback winfore selback selfore buttback buttfore textback \
		textfore headback headfore lightback lightfore coloron wishdir \
		libdir current_scheme bogomips
	if {$coloron == 0} {
		source [file join $libdir wishcolorplus.tcl]
		set coloron 1
	}
	wishcolorplus ; # This does all the work--from WISH Color Picker Plus
	wm title .colo "WISH Command Center : WISH Color Picker Plus"
}


### ADD/EDIT PROGRAM LISTING ###

# Procedure to set up GUI frame to add program to list or edit program listing:
proc fixbox {whattodo} {
	toplevel .fix
	label .fix.disptitle -text "Display Name:"
	entry .fix.dispname -width 36 -bg $::textback -fg $::textfore
	label .fix.offtitle -text "Official Name:"
	entry .fix.offname -width 36 -bg $::textback -fg $::textfore
	frame .fix.butts
	button .fix.what -text "$whattodo Listing" -default	normal -relief solid -pady 1
	button .fix.can -text "Close" -default normal -pady 1 -command {
		destroy .fix
		bind . <Key-Return> {}
	}
	pack .fix.what .fix.can -in .fix.butts -side left -expand 1 -fill both
	foreach butt [list .fix.what .fix.can] {
	 	$butt configure -bg $::buttback -fg $::buttfore
	}
	focus .fix.dispname
	pack .fix.disptitle .fix.dispname .fix.offtitle .fix.offname .fix.butts \
		-in .fix -side top -expand 1 -fill both
	if {$whattodo == "Add"} {
		.fix.what configure -command addprog
		bind .fix <Key-Return> addprog
	} else {
		.fix.what configure -command putedit
		bind .fix <Key-Return> putedit
		editprog
	}
}

# Procedure to add program to list:
proc addprog {} {
	global proglist progfile
	selection clear
	set dispname [.fix.dispname get]
	set offname [.fix.offname get]
	set newprog [list $dispname $offname]
	lappend proglist $newprog
	.lb insert end $dispname
	.lb see end
	savefig
	.fix.dispname delete 0 end
	.fix.offname delete 0 end
	focus .fix.dispname
}
 
# Procedure to get ready to edit a program listing:
proc editprog {} {
	global proglist editnum
	set getlin [.lb curselection]
	if {$getlin == "" || [llength $getlin] > 1} {
		tk_messageBox -message "Please select exactly one program\
			listing to edit" -type ok
		destroy .fix
	} else {
		set editthis [.lb get $getlin]
		set editnum [lsearch -index 0 $proglist $editthis]
		set editline [lindex $proglist $editnum]
		.fix.dispname delete 0 end
		.fix.dispname insert 0 [lindex $editline 0]
		.fix.offname delete 0 end
		.fix.offname insert 0 [lindex $editline 1]
	}
}

# Procedure to replace unedited entry with edited entry in list:
proc putedit {} {
	global proglist progfile editnum
	set dispname [.fix.dispname get]
	set offname [.fix.offname get]
	set newprog [list $dispname $offname]
	if {$dispname != "" && $offname != ""} {
		set proglist [lreplace $proglist $editnum $editnum $newprog]
		savefig
		.lb delete $editnum
		.lb insert $editnum $dispname
	}
	.fix.dispname delete 0 end
	.fix.offname delete 0 end
	.lb see $editnum
	focus .fix.dispname	
}


### DELETE LISTING(S) ###

# Procedure to unlist programs:
proc unlist {} {
	global progfile proglist deleteds
	set getlines [.lb curselection]
	set getleng [expr [llength $getlines] -1]
	foreach g [range $getleng to 0] {
		set gitlin [lindex $getlines $g]
		set getlain [.lb get $gitlin]
		set doidump [lsearch -index 0 $proglist $getlain]
		if {$doidump != -1} {
			lappend deleteds $getlain
			set proglist [lreplace $proglist $doidump $doidump]
        }
		.lb delete $gitlin
	}
	savefig
}


### SORT LIST ###

# Procedure to sort the list in alphabetical order:
proc sortlist {} {
	global progfile proglist
	set proglist [lsort -index 0 -dictionary $proglist]
	set progline "set proglist \[list $proglist\]"
	set progleng [llength $proglist]
	.lb delete 0 end
	foreach p [range 0 no $progleng] {
		set progline [lindex $proglist $p]
		.lb insert end [lindex $progline 0]
	}
	savefig
}


### KILL ###

# Procedure to determine whether to use xkill
# or (forthcoming) whimkill, when available:

proc bumpoff {} {
	set isitwhim [lsearch [winfo interps] Whim] ; # Is Whim the wm?
	if {$isitwhim != -1} {
		if {[inpath whimkill]} {
			eval exec whimkill
		} else {
			tk_messageBox -message "Sorry, \"whimkill\" is not yet available\
				on this system, and \"xkill\" won't work right on Whim.\
				Please right-click the titlebar of the offending window\
				and select \"Destroy Unresponsive Window.\"" -type ok
		}
	} else {
		if {[inpath xkill]} {
			eval exec xkill
		} else {
			bumplist
		}
	}
}

# Procedure to bump off a program when xkill isn't around
# (pretty clunky--hope that doesn't happen!):

proc bumplist {} {
	global env
	set buser $env(USER)
	set cess [eval exec ps U $buser -o pid,cmd]
	set cess [split $cess \n]
	set cess [lrange $cess 1 "end-1"]
	set bumpoes [list]
	foreach item $cess {
		set afterpid [lindex $item 1]
		if {[string first "/" $afterpid] ne 0 && \
			[string first "\[" $item] eq -1} {
			lappend bumpoes $item
			set bumpoes [lsort -index 1 $bumpoes]
		}
	}
	foreach item $cess {
		set afterpid [lindex $item 1]
		if {[string first "/" $afterpid] eq 0 && \
			[string first "\[" $item] eq -1} {
			lappend bumpoes $item
		}
	}
	foreach item $cess {
		set afterpid [lindex $item 1]
		if {[string first "/" $afterpid] ne 0 && \
			[string first "\[" $item] ne -1} {
			lappend bumpoes $item
		}
	}
	toplevel .bump
	wm title .bump "KILL"
	grid [listbox .bump.list -height 20 -width 60 -selectmode single] \
		-row 0 -column 0 -sticky news
	.bump.list configure -bg $::textback -fg $::textfore
	lappend ::lublist .bump.list
	grid [ttk::scrollbar .bump.roll -width 10 -command ".bump.list yview"] \
		-row 0 -column 1 -sticky news
	.bump.list configure -yscrollcommand ".bump.roll set"
	frame .bump.fr
	button .bump.kill -text "K  I  L  L" -command {
		set lino [.bump.list curselection]
		if {$lino ne ""} {
			set targ [.bump.list get $lino]
			set pid [lindex $targ 0]
			eval exec kill $pid
			destroy .bump
		} else {
			tk_messageBox -message "If you insist on killing a program,\
				please select one" -type ok
		}
	}
	button .bump.can -text "C a n c e l" -command {destroy .bump}
	foreach butt [list .bump.kill .bump.can] {
		$butt configure -bg $::buttback -fg $::buttfore
		lappend ::buttlist $butt
	}
	pack .bump.kill .bump.can -in .bump.fr -side left -expand 1 -fill both
	grid .bump.fr -row 1 -column 0 -columnspan 2 -sticky news
	foreach item $bumpoes {
		.bump.list insert end $item
	}
}


### GET GOING ###

getlist
autoadd

# Load most recently used color scheme, if specified in configuration
# file; if not, load "AntiqueBisque" color scheme as default;
# if not that either, complain:

if {[info exists current_scheme]} {
	source [file join $colordir $current_scheme.tcl]
} elseif {[file readable [file join $colordir AntiqueBisque.tcl]]} {
	source [file join $colordir AntiqueBisque.tcl]
} else {
	tk_messageBox -message "Current color scheme file not found\
	in $colordir" -type ok
}

