#! /usr/local/bin/wish
#
# Default location for wish is /usr/local/bin/wish.
# If it is somewhere else, change the above line.

# TkBiblook, v1.4.3, May 11th, 1996
# ftp://ftp.inslab.uky.edu/pub/tcl/tkbiblook/tkbiblook.tar.gz
#
# Department of Computer Science, University of Kentucky
# Joel Abbott <abbott@inslab.uky.edu>
# Jerzy W. Jaromczyk <jurek@cs.engr.uky.edu>

# quick check to see we are running 4.0 or later
if {$tk_version < 4.0} {
	tk_dialog .error {Fatal Error} \
		"TkBiblook requires Tk version 4.0 or later." "" 0 {Quit}
	exit 1
}

# init procedure, truncate file if it exists, create it if it doesn't
proc Truncate {filename} {
	set fp [open "$filename" w 0600]
	close $fp
}

# clear text area and savefile
proc Clear {} {
	global log savefile

	$log delete 0.0 end
	Truncate $savefile
}

# toggle clear or append modes for lookups
proc Changemode {} {
	global mode

	if ![string compare "$mode" "clear"] {
		set mode append
		destroy .control.mode
		button .control.mode -image append -command Changemode
		pack .control.mode -padx 200 -side right
	} else {
		set mode clear
		destroy .control.mode
		button .control.mode -image clear -command Changemode
		pack .control.mode -padx 200 -side right
	}
}

# set search type
proc SearchType {type} {
	global .input init command

	# first time around don't destroy
	if {$init == 1} {
		set init 0
	} else {
		destroy .input.label .input.cmd
	}

	# create label and command prompt
	label .input.label -text "$type  " -anchor e
	entry .input.cmd -width 95 -relief sunken -textvariable command
	pack .input.label .input.cmd -side left -fill x -expand true
	.input.cmd config -background white

	# have window focus on search string input
	focus .input.cmd

	# key binding equivs
	bind .input.cmd <Return> {Run $choice}
	bind .input.cmd <Alt-a> {Admin}
	bind .input.cmd <Alt-h> {Help}

	# zero-out command
	set command {}
}

# make .bix file from .bib file
proc MakeBix {bibfile} {
	global bibindex

	# create pause window
	set pause [toplevel .pausebix -borderwidth 10]
	wm geometry $pause +300+300
	wm title $pause Pause
	message $pause.msg -width 200 -font 10x20 -text "Creating index file.  Please wait..."
	pack $pause.msg -side left -fill x -ipadx 50 -ipady 50

	# grab this window until we are done
	grab $pause
	update
	CheckPrg $bibindex
	catch [list exec $bibindex $bibfile] result
	puts stdout $result
	grab release $pause
	destroy $pause
}

# run make to compile $program
proc MakePrg {program} {
	global helper

	# create pause window
	set pause [toplevel .pause$program -borderwidth 10]
	wm geometry $pause +300+300
	wm title $pause Pause
	message $pause.msg -width 200 -font 10x20 -text "Compiling $program.  Please wait..."
	pack $pause.msg -side left -fill x -ipadx 50 -ipady 50

	# grab this window until we are done
	grab $pause
	update
	catch [list exec $helper make $program] result
	puts stdout $result
	grab release $pause
	destroy $pause
}

# find environment variable
proc GetEnv {lookfor} {
	global env

	foreach var [array names env] {
		if ![string compare $lookfor $var] {
			return $env($var)
		}
	}
	return ""
}

# exit
proc Stop {} {
	global searchfile savefile pid

	# cleanup and leave
	exec rm -f $searchfile $savefile
	exit 1
}

# save results of lookup
proc Save {} {
	global savefile cancel

	# get filename
	set cancel false
	set name [GetName]
	if ![string compare "$cancel" "true"] {
		return
	}
	if ![string length $name] {
		tk_dialog .error {Warning Error} "No filename given" "" 0 \
			{Dismiss}
		return
	}
	if [file exist $name] {
		set answer [tk_dialog .error {Warning Error} \
			"$name already exists.  Overwrite?" "" 0 {OK} {Quit}]
		if {$answer != 0} {
			Stop
		}
	}
	Copy $savefile $name
}

# do a find or whatis lookup
proc Run {which} {
	global bib biblook searchfile savefile command log mode type

	# check for ';' in input - not allowed
	if [string match {*;*} "$command"] {
		tk_dialog .error {Warning Error} "Sorry - ';' characters are not allowed in the search string.  Please see the '?' button for more information." "" 0 {Dismiss}
		return
	}

	if ![string compare "$command" ""] {
		tk_dialog .error {Warning Error} "No search string given" "" \
			0 {Dismiss}
		return
	}

	# create pause window and mouse, grab window
	set pause [toplevel .pauserun -borderwidth 10]
	wm geometry $pause +300+300
	wm title $pause Pause
	message $pause.msg -width 200 -font 10x20 -text "Executing.  Please wait..."
	pack $pause.msg -side left -fill x -ipadx 50 -ipady 50
	grab $pause
	$pause config -cursor watch
	update

	# clear type if regular expression
	if ![string compare "$type" "Regular Expression"] {
		set type ""
	}

	# do queries and save
	Truncate $searchfile
	if ![string compare "$mode" "clear"] {
		Clear
	}
	CheckPrg $biblook
	set biblookinput [open "| $biblook $bib" w]
	puts $biblookinput "find author HACKHACKHACKHACKHACK"
	if ![string compare "$which" find] {
		puts $biblookinput "$which $type $command"
	} else {
		puts $biblookinput "$which $command"
	}
	puts $biblookinput "save $searchfile"
	puts $biblookinput "quit"
	close $biblookinput

	# only for finds
	if ![string compare "$which" find] {
		Append $searchfile $savefile
	}

	# put it in the scollbar text widget
	set add [open "$searchfile" r]
	$log insert end [read $add]
	close $add

	# remove pause window and restore mouse pointer
	grab release $pause
	destroy $pause

	# did we find anything?
	if ![file size $searchfile] {
		tk_dialog .error {Results} "Nothing Found" "" 0 {Dismiss}
	} else {
		set numfound [exec grep "^@" $searchfile | wc -l 2> /dev/null]
		tk_dialog .error {Results} "$numfound Matches Found" "" 0 \
			{Dismiss}
	}
}

# most of the help information taken from the biblook man page
proc Help {} {
	global libdir

	# place help window
	set help [toplevel .help -borderwidth 10]
	wm title $help Help
	wm geometry $help 100x30

	# create scrollbar text area
	frame $help.output
	pack $help.output -side top -fill both -expand true
	set log [text $help.output.log -font 10x20 -width 80 -height 24 \
		-borderwidth 2 -relief groove -setgrid true -yscrollcommand \
		[list $help.output.scroll set]]
	scrollbar $help.output.scroll -command [list $help.output.log yview]
	pack $help.output.scroll -side left -fill y
	pack $help.output.log -side left -fill both -expand true
	$help.output.scroll config -background lightsteelblue4

	# load scrollbar text area with help file
	set helpfile [open "$libdir/help.txt" r]
	$log insert 0.0 [read $helpfile]
	close $helpfile

	# frame for the Dismiss button
	frame $help.control -borderwidth 10
	pack $help.control -side bottom -fill x

	# Dismiss button
	set inhelp true
	button $help.control.ok -text Dismiss -command {set inhelp false}
	pack $help.control.ok -side left
	$help.control.ok config -background lightsteelblue4

	# key binding equivs
	bind $help <Return> {set inhelp false}

	# grab this window and wait until the Dismiss button is pressed
	grab $help
	update
	tkwait variable inhelp
	grab release $help
	destroy $help
}

# register just so that i can get an idea how many people might
# be using TkBiblook
proc Register {} {
	global helper

	set answer [tk_dialog .error {Warning Error} "This option will attempt to send a piece of mail to the author of TkBiblook so that he can show his Academic Advisor (and the Chairperson of the Computer Science Department at the University of Kentucky) that people are using this program.  Are you sure you want to do this?" \
		"" 0 {Send} {Don't Send}]
	if {$answer == 0} {
		catch [list exec $helper register] result
		puts stdout $result
	}
}

# send in a suggestion to me
proc Suggest {} {
	global helper

	catch [list exec $helper suggest] result
	puts stdout $result
}

# modified version of dialog example taken from
# "Practical Programming in Tcl and Tk", by Brent B. Welch, pg 207
proc GetName {} {
	global savename cancel

	set f [toplevel .prompt -borderwidth 10]
	wm geometry $f +275+275
	wm title $f Save
	label $f.label -text {Filename:} -padx 0
	entry $f.entry -textvariable savename(result)
	set b [frame $f.buttons -bd 10]
	pack $f.label $f.entry $f.buttons -side left -fill x
	$f.entry config -background white

	button $b.ok -text OK -command {set savename(ok) 1} -underline 0
	button $b.cancel -text Cancel -command {set savename(ok) 0} -underline 0
	pack $b.ok -side left
	pack $b.cancel -side right

	foreach w [list $f.entry $b.ok $b.cancel] {
		bindtags $w [list .prompt [winfo class $w] $w all]
	}
	bind .prompt <Alt-o> "focus $b.ok ; break"
	bind .prompt <Alt-c> "focus $b.cancel ; break"
	bind .prompt <Alt-Key> break
	bind .prompt <Return> {set savename(ok) 1}
	bind .prompt <Control-c> {set savename(ok) 0}

	focus $f.entry
	grab $f
	tkwait variable savename(ok)
	grab release $f
	destroy $f
	if {$savename(ok)} {
		return $savename(result)
	} else {
		set cancel true
		return {}
	}
}

# copy a file
proc Copy {from to} {
	if ![file exist $from] {
		tk_dialog .error {Fatal Error} "$from doesn't exist" "" 0 \
			{Quit}
		Stop
	}
	set fromfp [open "$from" r]
	set data [read $fromfp]
	close $fromfp

	set tofp [open "$to" w 0600]
	puts -nonewline $tofp $data
	close $tofp
}

# append to a file
proc Append {from to} {
	if ![file exist $from] {
		tk_dialog .error {Fatal Error} "$from doesn't exist" "" 0 \
			{Quit}
		Stop
	}
	set fromfp [open "$from" r]
	set data [read $fromfp]
	close $fromfp

	if ![file exist $to] {
		set answer [tk_dialog .error {Fatal Error} \
			"$to doesn't exist.  Create?" "" 0 {OK} {Quit}]
		if {$answer != 0} {
			Stop
		}
		Truncate $to
	}
	set tofp [open "$to" a]
	puts -nonewline $tofp $data
	close $tofp
}

# check to see if hash file exists.  if not, ask if we want to create it.
proc CheckBix {bibfile} {
	global bibsuffix bixsuffix

	# replace $bibsuffix in the geometry database path with $bixsuffix
	set prefix [string trimright $bibfile $bibsuffix]
	set bix $prefix$bixsuffix

	# check to see if .bix file exists - if not, run bibindex
	if ![file exist $bix] {
		set answer [tk_dialog .error {Warning Error} \
			"$bix doesn't exist.  Create?" "" 0 {OK} {Quit}]
		if {$answer != 0} {
			Stop
		}
		MakeBix $bibfile
	}
}

# check to see if bibindex/biblook exist.  if not, ask if we want to try to
# compile them.
proc CheckPrg {program} {
	# check to see if $program exists
	if ![file exist $program] {
		set answer [tk_dialog .error {Warning Error} \
			"I can't find $program.  Results not guaranteed, but I can attempt to compile it.  Compile?" "" 0 {OK} {Quit}]
		if {$answer != 0} {
			Stop
		}
		MakePrg $program
	}
}


# variables - set libdir to something if you have installed the tkbiblook
#	directory somewhere besides the current directory
set pid [pid]
set myname tkbiblook
set libdir ./$myname
set searchfile /tmp/$myname.search.$pid
set savefile /tmp/$myname.save.$pid
set init 1
set type Title
set defbibname geom.bib
set bibsuffix .bib
set bixsuffix .bix
set helper tkbiblook.helper
set biblook biblook
set bibindex bibindex
set env(PATH) [GetEnv PATH]:/usr/local/bin:/usr/bin:/usr/ucb:/bin:/usr/etc:/etc:/usr/sbin:/sbin:/usr/contrib/bin:/usr/openwin/bin:/usr/5bin:/usr/bsd:.
# trying a PATH which might fit most unix types

# colors and feel
tk_setPalette grey
wm title . TkBiblook
wm geometry . +50+50
wm iconbitmap . @$libdir/icon.xbm
#bell

# images
image create photo title -file $libdir/title.gif
image create photo go -file $libdir/go.gif
image create photo help -file $libdir/help.gif
image create photo clear -file $libdir/clear.gif
image create photo append -file $libdir/append.gif
image create photo stop -file $libdir/stop.gif
image create photo save -file $libdir/save.gif

# title name, picture, and setup
frame .banner -relief raised -bd 1
pack .banner -side top -fill x
label .banner.name -font 10x20 -text {Computational Geometry Bibliography Database} \
	-justify center
label .banner.credit -text {Tcl/Tk interface developed at the Computer Science Department, University of Kentucky} \
	-justify center
label .banner.title -image title
pack .banner.name .banner.credit .banner.title -side top
Truncate $savefile

# menu for types of searches
frame .mbar -relief raised -bd 1
pack .mbar -side top -fill x
menubutton .mbar.search -text SearchType -menu .mbar.search.menu
menubutton .mbar.config -text Config -menu .mbar.config.menu
menubutton .mbar.admin -text Administrative -menu .mbar.admin.menu
button .mbar.help -relief flat -text Help -underline 0 -command Help
pack .mbar.search -padx 10 -side left
#pack .mbar.config -padx 10 -side left
pack .mbar.help -padx 10 -side right
pack .mbar.admin -padx 10 -side right
set search [menu .mbar.search.menu]
$search add radio -label Title -variable type -command { SearchType $type }
$search add radio -label Author -variable type -command { SearchType $type }
$search add radio -label Year -variable type -command { SearchType $type }
$search add radio -label Note -variable type -command { SearchType $type }
$search add separator
$search add radio -label "Regular Expression" -variable type \
	-command { SearchType $type }
set config [menu .mbar.config.menu]
$config add radio -label Find -variable choice -value find
$config add radio -label Whatis -variable choice -value whatis
set admin [menu .mbar.admin.menu]
$admin add radio -label Register -command Register
#$admin add radio -label Suggest -command Suggest
tk_menuBar .mbar .mbar.search .mbar.config .mbar.admin .mbar.help
set choice find

# frame for find output
frame .output
set log [text .output.log -width 80 -height 24 -borderwidth 2 -relief sunken \
	-setgrid true -wrap none -xscrollcommand [list .output.xscroll set] \
	-yscrollcommand [list .output.yscroll set]]
scrollbar .output.xscroll -orient horizontal -command [list .output.log xview]
scrollbar .output.yscroll -orient vertical -command [list .output.log yview]
pack .output.xscroll -side bottom -fill x
pack .output.yscroll -side left -fill y
pack .output.log -side right -fill both -expand true
pack .output -side top -fill both -expand true
.output.xscroll config -background lightsteelblue4
.output.yscroll config -background lightsteelblue4

# frame for search string widgets
frame .input -borderwidth 10
pack .input -side top -fill x

# set initial search type
SearchType $type

# frame for info1 stuff (SAVE and QUIT info)
frame .info1
pack .info1 -side bottom -fill x

# save info
label .info1.save -font 6x10 -text {Press SAVE to save results of lookup}
pack .info1.save -side left -padx 10

# quit info
label .info1.quit -font 6x10 -text {Press QUIT to exit TkBiblook}
pack .info1.quit -side right -padx 10

# frame for info2 stuff (GO, ?, and CLEAR/APPEND info)
frame .info2
pack .info2 -side bottom -fill x

# go info
label .info2.go -font 6x10 -text {Press GO or hit RETURN to begin lookup}
pack .info2.go -side left -padx 10

# help info
label .info2.help -font 6x10 -text {Press the '?' button for Help}
pack .info2.help -side right -padx 10

# clear/append info
label .info2.mode -font 6x10 -text {Press CLEAR/APPEND to change modes}
pack .info2.mode -side right -padx 90

# frame for all of the buttons
frame .control -borderwidth 10
pack .control -side bottom -fill x

# save button
button .control.save -image save -command Save
pack .control.save -side left

# go button, queries radiobutton to see what to do
button .control.go -image go -command {Run $choice}
pack .control.go -side left

# stop button
button .control.stop -image stop -command Stop
pack .control.stop -side right

# help button
button .control.help -image help -command Help
pack .control.help -side right

# clear/append button
set mode append
button .control.mode
Changemode

# get name of database from command line default to $defbibname otherwise.
if {$argc > 0} {
	set bib [lindex $argv 0]

	# check to see if .bib and .bix files exist
	if ![file exist $bib] {
		tk_dialog .error {Fatal Error} "$bib doesn't exist" "" 0 \
			{Quit}
		Stop
	}
	CheckBix $bib
} else {
	# set the name of the geometry database as the default
	set bib $defbibname

	# check to see if .bib and .bix files exist in current directory
	if [file exist $bib] {
		CheckBix $bib
	} else {
		# at this point, the geometry database was not
		# given on the command line.  check to see if the
		# BIBLOOKPATH or BIBINPUTS environmental variables
		# are defined.  if not, then exit because we won't
		# be able to run biblook without knowing where the
		# geometry database is.  if they were defined, then
		# check the dir list to see if the database and
		# hashfile exists.

		set biblookpath [GetEnv BIBLOOKPATH]
		set bibinputs [GetEnv BIBINPUTS]

		if {![string length $biblookpath] && ![string length $bibinputs]} {
			tk_dialog .error {Fatal Error} "Geometry database path not given on command line, and BIBLOOKPATH and BIBINPUTS environmental variables are not set." "" 0 {Quit}
			Stop
		}

		# check the dirs
		set hit 0

		# first check BIBLOOKPATH
		if [string length $biblookpath] {
			foreach dir [split $biblookpath :] {
				if [file exist $dir/$bib] {
					set hit 1
					CheckBix $dir/$bib
					break
				}
			}
		}

		# next check BIBINPUTS
		if { $hit == 0 } {
			if [string length $bibinputs] {
				foreach dir [split $bibinputs :] {
					if [file exist $dir/$bib] {
						set hit 1
						CheckBix $dir/$bib
						break
					}
				}
			}
		}

		# if we got a hit, then we are ok, else we have to
		# exit because we couldn't find the geometry database
		# in the environmental variables.
		if { $hit == 0 } {
			tk_dialog .error {Fatal Error} "Geometry database path not given on command line, and $bib was not found in one of the directories listed in the environmental variables BIBLOOKPATH and BIBINPUTS." "" 0 {Quit}
			Stop
		}
	}
}