head	1.16;
access;
symbols;
locks
	jimbo:1.16;
comment	@# @;


1.16
date	93.05.07.21.42.15;	author jimbo;	state Exp;
branches;
next	1.15;

1.15
date	93.05.05.21.17.28;	author jimbo;	state Exp;
branches;
next	1.14;

1.14
date	93.05.05.21.16.19;	author jimbo;	state Exp;
branches;
next	1.13;

1.13
date	93.04.30.23.34.19;	author jimbo;	state Exp;
branches;
next	1.12;

1.12
date	93.04.23.21.40.06;	author jimbo;	state Exp;
branches;
next	1.11;

1.11
date	93.04.23.15.50.58;	author jimbo;	state Exp;
branches;
next	1.10;

1.10
date	93.04.20.14.13.52;	author terry;	state Exp;
branches;
next	1.9;

1.9
date	93.04.08.18.55.06;	author jimbo;	state Exp;
branches;
next	1.8;

1.8
date	93.04.08.18.30.09;	author jimbo;	state Exp;
branches;
next	1.7;

1.7
date	93.04.08.17.43.06;	author jimbo;	state Exp;
branches;
next	1.6;

1.6
date	93.04.07.22.05.40;	author miley;	state Exp;
branches;
next	1.5;

1.5
date	93.04.07.21.03.38;	author jimbo;	state Exp;
branches;
next	1.4;

1.4
date	93.04.07.00.32.32;	author jimbo;	state Exp;
branches;
next	1.3;

1.3
date	93.04.06.21.38.39;	author miley;	state Exp;
branches;
next	1.2;

1.2
date	93.04.06.18.19.29;	author miley;	state Exp;
branches;
next	1.1;

1.1
date	93.04.06.18.08.16;	author miley;	state Exp;
branches;
next	;


desc
@@


1.16
log
@fixed calls for terry's guibuilder
@
text
@#!/usr/local/bin/wish -f

set PGB(WishLocation) /usr/local/bin/wish

if [info exists env(PGBROWSE)] {
	set PGB(Home) $env(PGBROWSE)
} else {
	set PGB(Home) /usr/local/pg_browse
}
if ![file exists $PGB(Home)/lib/pg_browse.tcl] {
	error "$PGB(Home) is not the PGBROWSE installation directory.\nPlease set your PGBROWSE environment variable to the correct location."
	exit 1
}

set PGB(Tmp) /tmp
if [info exists env(TMPDIR)] {
	if [file writable $env(TMPDIR)] {set PGB(Tmp) $env(TMPDIR)}
}

if [info exists env(PGHOST)] {
       	set PGB(Host) $env(PGHOST)
} else {
       	set PGB(Host) "heel.s2k.berkeley.edu"
}
if [info exists env(PGBACTIONINIT)] {
	set PGB(ActionInit) $env(PGBACTIONINIT)
} else {
	set PGB(ActionInit) pgb.tcl
}

set PGB(ActionDirs) {}
if [info exists env(PGBACTIONS)] {
	lappend PGB(ActionDirs) [split $env(PGBACTIONS) :]
}
foreach dir [glob -nocomplain $PGB(Home)/actions/*] {
	if {[file isdirectory $dir] && [lsearch $PGB(ActionDirs) $dir] == -1} {
		lappend PGB(ActionDirs) $dir
	}
}

set BITMAPDIR $PGB(Home)/bitmaps
set HELPDIR $PGB(Home)/help
source $PGB(Home)/lib/tkutils.tcl
source $PGB(Home)/lib/infobars.tcl
source $PGB(Home)/lib/FD.tcl
source $PGB(Home)/lib/pg_browse.tcl
source $PGB(Home)/lib/pg_query.tcl
source $PGB(Home)/lib/pg_action.tcl
source $PGB(Home)/lib/pg_create.tcl
source $PGB(Home)/lib/pg_guibuilder.tcl


set logfile $PGB(Tmp)/PGBrowse.[GetAPid]
set home $PGB(Home)
set host $PGB(Host)
set db {}
set class {}
if [catch {ParseArgs {add nobrowse :host fillclass :home :logfile showlog query :db :class} $argv}] UsageExit
set PGB(Db) $db
set PGB(Class) $class
set PGB(Logfile) $logfile
set PGB(Home) $home
set PGB(Host) $host

if [catch {set PGB(Logfd) [open $PGB(Logfile) w+]} err] {
	error "Couldn't open log file: $err"
	destroy .
	exit 1
}

ReadPGTypes
ScanActionDirs
InitPGBRoot
if $showlog OpenLog
GetDbs
GetClasses $db
GetAttributes $class
if $query QueryClass
if $add CreateClass 

unset db class logfile showlog query
@


1.15
log
@pg_guibuilder2 moved to lib, added pg_create
@
text
@d3 2
d47 1
a48 1
source $PGB(Home)/lib/pg_query.tcl
d50 1
a50 1
source $PGB(Home)/lib/pg_guibuilder2
@


1.14
log
@modified for tf's query tool
@
text
@d8 2
a9 2
if ![file exists $PGB(Home)/lib] {
	error "Error:\n\nThe $PGB(Home) directory is not the PGBROWSE installation directory.\nPlease set your PGBROWSE environment variable to the correct location."
d12 2
d15 1
a15 3
	set PGB(Tmp) $env(TMPDIR)
} else {
	set PGB(Tmp) /tmp
d17 1
a22 5
if [info exists env(PGBACTIONDIR)] {
	set PGB(ActionDir) $env(PGBACTIONDIR)
} else {
	set PGB(ActionDir) $PGB(Home)/actions
}
d24 1
a24 1
	set PGB(ActionInit) $env(PGBActionINIT)
d29 10
a41 1
source $PGB(Home)/lib/pg_browse.tcl
d44 2
d47 2
a49 5
# Terry's query tool
set env(PGBROWSE) $PGB(Home)
set env(PGSCRIPTS) $PGB(Home)/scripts
set pgbrowsedir $PGB(Home)
source $PGB(Home)/scripts/pg_guibuilder2
a50 1

d56 1
a56 1
if [catch {ParseArgs {nobrowse :host fillclass :home :logfile showlog query :db :class} $argv}] UsageExit
a62 1

d70 1
a70 1
ScanActionDir
a75 1
if $fillclass FillClass
d77 1
a79 2

puts stdout [join [DumpArray PGB] \n]
@


1.13
log
@*** empty log message ***
@
text
@a2 1
# set to the root of the pg_browse goodies...
d4 1
a4 10
	set pgbrowsedir $env(PGBROWSE)
	if ![file exists $pgbrowsedir/scripts] {
		puts stdout "
Error:

The $pgbrowsedir directory is not the PGBROWSE installation directory.
Please set your PGBROWSE environment variable to the correct location.
"
		exit
	}
d6 11
a16 26
	set pgbrowsedir /usr/local/pg_browse
	if ![file exists $pgbrowsedir/scripts] {
		puts stdout "
Error:

PGBROWSE was not installed in the default location: $pgbrowsedir.
Please set the PGBROWSE environment variable to the installation
directory.
"
		exit
	}
}

source $pgbrowsedir/scripts/pg_browse.tcl
source $pgbrowsedir/scripts/pg_guibuilder2


# init global variables
set db ""
set class ""
set dbs ""
set classes ""
set atts ""
set attnames ""
set atttypes ""
set newclass ""
d18 11
a28 1
       	set pghost $env(PGHOST)
d30 1
a30 1
       	set pghost "heel.s2k.berkeley.edu"
d33 43
a75 71
# create the info/progress box
frame .info
label .info.progress
label .info.bit -bitmap @@${pgbrowsedir}/bitmaps/redwood
label .info.title -text "Sequoia 2000 Database Browser"
pack append .info \
	.info.bit "left padx 10 pady 10" \
	.info.title "left padx 10 pady 10" \
	.info.progress "right padx 10 pady 10"

# create the menu bar
mkmenubar .menu {
	{ {About pg_browse} @@ABOUT }
	{ {Version} {Version .9Beta} }
	{ {Bugs/Missing Features} @@BUGS }
} {
	File {
		{{Set PGHOST} pghostdialog {
Change the Postgres server host.  The
initial server is set to your PGHOST
environment variable if it exists or
defaults to heel.s2k.berkeley.edu } }
		{{Show Log} showlog {Shows log of monitor commands in which you can insert notes about your work.} }
		{{Save Log} savelog {Save current log of monitor commands and any notes you entered.} }
		{{Re-Source pg_browse.tcl} {source $scriptsdir/pg_browse.tcl} {Edit's and re-loads pg_browse}}
		{{Re-Source tkutils.tcl} {source $scriptsdir/tkutils.tcl} {Edit's and re-loads tkutils}}
		{{Quit} quit_pgbrowse {Exits the application.} }
	}
} {
	Edit {
		{{New View} newview {Start a new pg_browser.} }
		{{New Database} newdb {Allows the user to create a new database on the current Postgres server.  You must have createdb privilege for this to work.} }
		{{New Class: integrated} newclass {Jim Davidson's version of how to create a new class within pg_browse.} }
		{{New Class: standalone} call_pg_edit {Terry Figel's versions of how to create classes which can operate outside of pg_browse.} }
	} 
} {
	Query {
		{{Create Query Tool} pg_makegui {Creates a User Interface for the current database and class allowing you to retrieve and append data. This tool will ultimately have hooks to 3rd party packages such as S, IDL, AVS, etc.} }
		{{Create Query Tool 2} pg_makegui2 {Creates a User Interface for the current database and class allowing you to retrieve and append data. This tool will ultimately have hooks to 3rd party packages such as S, IDL, AVS, etc.} }
	}
}

pack append . \
	.menu { top fillx } \
	.info { top fillx }



# Setup listboxes and pack 'em onto .

mklistbox .dbs { showclasses [selection get] }
mklistbox .classes { showattributes [selection get] }
mklistbox .atts { showattdescrip [selection get] }
mklistbox .types { showtypedescrip [selection get] }

# link attnames and atttypes together
proc scrollboth index {
	.atts.ls.l yview $index
	.types.ls.l yview $index
}
.atts.ls.s configure -command scrollboth
.types.ls.s configure -command scrollboth

set where "left padx 10 pady 10"
pack append . \
	.dbs $where \
	.classes $where \
	.atts $where \
	.types $where


d77 1
d79 1
a79 38


set logfilename "/tmp/pgbrowse.$env(USER).[GetAPid]"
set openshowlog 0
set a 0
while {$a < $argc} {
	set arg [lindex $argv $a]
	case $arg in {
  		-l*	{
			incr a 1
			if {[lindex $argv $a] == ""} usageexit
			set logfilename [lindex $argv $a]
			}
  		-s*	{ set openshowlog 1 }
		default break
	}
	incr a 1
}

# open the temparary log file
if [catch {set logfile [open $logfilename w+]}] {
	puts stderr "Error:  can't open log file - using stderr..."
	set logfile stderr
} 

if $openshowlog showlog


# fill in the .dbs listbox
getdbs

if { [lindex $argv $a] != "" } {
	showclasses [lindex $argv $a]
	incr a 1
	if { [lindex $argv $a] != "" } {
		showattributes [lindex $argv $a]
	}
}
@


1.12
log
@*** empty log message ***
@
text
@d29 2
a31 25
# setup some paths
set bitmapdir $pgbrowsedir/bitmaps
set scriptsdir $pgbrowsedir/scripts
set gluedir $pgbrowsedir/gluedir
set gluerun Runme.tcl
set env(HELPDIR) $pgbrowsedir/help
set env(PGSCRIPTS) $scriptsdir
set env(BITMAPDIR) $bitmapdir
set env(GLUEDIR) $gluedir
set path [split $env(PATH) :]
if {[lsearch $path $scriptsdir] < 0} {
	set env(PATH) $env(PATH):$scriptsdir
}
# source the tk utilities (infobox, mklistbox, etc.)
source ${scriptsdir}/pg_guibuilder2

#source ${scriptsdir}/tkutils

# look for monitor in user's path or some default locations
set defpath ~postgres/bin:/usr/local/postgres/bin:/usr/postgres/bin
if {[set monitor [searchpath monitor $defpath ]] == ""} {
	wm withdraw .
	errorbox "Could not find monitor in your PATH or the default locations:\n$defpath."
	exit
}
d33 1
a33 1
# global variables
a47 541
# read in the pgtypes file and fill in typname and typdescrip
# arrarys:
if { ![file exists $scriptsdir/pgtypes] } {
	wm withdraw .
	errorbox "Can't find the Postgres type descriptions file:  $scriptsdir/typdescrip"
	exit
}
set fd [open $scriptsdir/pgtypes]
while { ![eof $fd] } {
	set line [gets $fd]
	case $line in \
		#* {} \
		{} {} \
		default { 
			set line [split $line \t]
			set name [lindex $line 0]
			set descrip [lindex $line 1]
			set typdescrip($name) $descrip
			set typname($descrip) $name
			}
}
close $fd

# get gluescripts array...
if ![file exists $gluedir] {
#	noticebox "GLUEDIR $gluedir does not exists - you won't be able to perform any actions on retrieved data."
} else {
	foreach site [exec ls $gluedir] {
		foreach action [exec ls $gluedir/$site] {
			if [file exists $gluedir/$site/$action/$gluerun] {
				lappend gluescripts($site) $action
			}
		}
	}
}



proc quit_pgbrowse { } {
	global logfile logfilename
	catch {close $logfile}
	if [yesno "Save log file?" 0 Yes No] savelog
	exec rm -f $logfilename
	destroy .
}

proc DoMonitor { cmd ret {flags {-N -T -Q}}} {
	global monitor pghost db logfile
	upvar 1 $ret r
	set cmd [string trim $cmd]
	addtolog "monitor $flags -c '$cmd'" "PostQuel Command:"
	set cmd "{$cmd}"
	update
	set file [open "|$monitor $flags -h $pghost -c $cmd $db" r]
	set mr [read $file]
	if {[catch { close $file } err] != 0} {
		set r $err
		addtolog $r "Return:  ERROR:"
		return 0
	} else {
		addtolog $mr "Return:  SUCCESS:"
		set r ""
		foreach line $mr {
			lappend r [string trim $line]
		}
		return 1
	}
}

proc addtolog { r code } {
	global logfile
	set log "$code\n$r\n\n"
	puts $logfile $log
	if [winfo exists .showlog.text] {
		.showlog.text insert end $log
		.showlog.text yview -pickplace insert
	}
}
	
proc showlog { } {
	global logfile logfilename
	seek $logfile 0
	toplevel .showlog
	wm title .showlog "Postquel Command Log:  $logfilename"
	text .showlog.text -yscroll {.showlog.sb set} -bd 2 -relief sunken
	scrollbar .showlog.sb -command {.showlog.text yview}
	.showlog.text insert insert [read $logfile]
	.showlog.text tag configure bold -font -Adobe-Courier-Bold-O-Normal-*-120-*
	mkmenubar .showlog.menu {
		{About {This window displays the commands sent to the Postgres backend and the messages returned.  You can save the log at anytime into a flat ascii text file.  Also, you can add notes to the log by simply clicking at the desired location and typing - your notes will be saved along with the Postquel dialog.}}
	} {
		File {	
			{{Save Log} savelog {Save the current Postquel log to a file.}}
			{Close close_log {Removes the log window}}
		}
	}
	label .showlog.progress 
	pack append .showlog \
		.showlog.menu { top fillx } \
		.showlog.progress { top frame e pady 5m padx 5m} \
		.showlog.text left \
		.showlog.sb {left filly}
}

proc close_log { } {
	global logfile
	seek $logfile 0
	puts $logfile [.showlog.text get 0.0 end]
	destroy .showlog
}

proc savelog { } {
	global logfile file env
	set file(filename) "pgbrowse.log"
	if ![info exists file(cwd)] {
		set file(cwd) $env(HOME)
	}
	if [FDSave "Save Postquel Log"] {
		set fd [open $file(cwd)/$file(filename) w]
		if [winfo exists .showlog.text] {
			puts $fd [.showlog.text get 0.0 end]
		} else {
			flush $logfile
			seek $logfile 0
			puts $fd [read $logfile]
		}
		close $fd
	}
}

# get a list of databases on the current pghost and fill
# in the first listbox
proc getdbs {} {
	global pghost dbs classes class db env
	foreach box { .dbs .classes .atts .types } {
		clearbox $box.ls.l
		$box.t configure -text ""
	}
	delalltoplevels
	set classes ""
	set class ""
	.dbs.t configure -text "$pghost"
	working

	set db $env(USER)
	if ![DoMonitor "retrieve(pg_database.datname)" dmret] {
		set db template1
		if ![DoMonitor "retrieve(pg_database.datname)" dmret] {
			errorbox "Could not get database list; Postgres error:\n\n$dmret"
			return 
		}
	}
	set db ""
	set dbs [lsort $dmret]
	fillbox .dbs.ls.l $dbs
	waiting
}


# get a list of classes in the current database, fill
# in the second listbox
proc showclasses { d } {
	global db dbs class classes
	if { [lsearch $dbs $d] < 0 } {
		set class ""
		errorbox "No such database: $d"
		return
	}	
	set db $d
	delalltoplevels
	working
	clearbox .classes.ls.l
	clearbox .atts.ls.l
	clearbox .types.ls.l
	.classes.t configure -text "$db"
	.atts.t configure -text ""
	.types.t configure -text ""
	update
	if ![DoMonitor {retrieve(pg_class.relname)where pg_class.relname !~ "^pg_"} dmret] {
		errorbox "Could not get classes list; Postgres error:\n\n$dmret"
		return 
	}
	set classes [lsort $dmret]
	fillbox .classes.ls.l $classes
	waiting
}

# get a list of attributes in the current class, fill
# in the third and fourth listboxes
proc showattributes { c } {
	global db class classes atts attnames atttypes
	if { [lsearch $classes $c] < 0 } {
		errorbox "No such class: $c"
		set class ""
		return
	}	
	set class $c
	delalltoplevels
	working
	clearbox .atts.ls.l
	clearbox .types.ls.l
	.atts.t configure -text "$class names" 
	.types.t configure -text "$class types"
	update
	global monitorret
	if ![DoMonitor "

retrieve(pg_attribute.attname,pg_type.typname)
where pg_attribute.attrelid = pg_class.oid
and   pg_attribute.atttypid = pg_type.oid
and   pg_attribute.attnum   > 0
and   pg_class.relname = \"$class\"

	    " dmret] {
		errorbox "Could not get classes list; Postgres error:\n\n$dmret"
		return 
	}
	set atts [join [lsort [ split $dmret \n ] ] ]
	set attnames ""
	set atttypes ""
	set natts [llength $atts]
	for {set i 0} {$i < $natts} {incr i 2} {
		lappend attnames [lindex $atts $i]
		lappend atttypes [lindex $atts [expr $i+1] ]
	}
	catch { fillbox .atts.ls.l "$attnames" }
	catch { fillbox .types.ls.l "$atttypes" }
	waiting
}



# pop up an info box with a description of an attribute
proc showattdescrip { a } {
	global db class pghost
	set att $a
	working
	if ![DoMonitor "

retrieve(class_info.attdescrip)
where	class_info.class = \"$class\"
and	class_info.attname = \"$att\"

	    " descrip] { set descrip "No description available." }

	waiting

	infobox \
"Attribute Info

Host:		$pghost
Database:	$db
Class:		$class

$att:

$descrip
"

}

# pop up an info box with a description of a type
proc showtypedescrip { type } {
	global db pghost class typdescrip

	set array ""
	if [regsub ^_ $type "" type] {
		set array "Array of "
	}
	if [catch {set desc $array$typdescrip($type)}] {
		set desc "No description available."
	}
		
	infobox \
"Type Info

Host:		$pghost
Database:	$db
Class:		$class

$type:

$desc
"

}

# prompt for a new pghost
proc pghostdialog { } {
	global pghost db 
	set newpghost [entrydialog "PGHOST" $pghost]
	if {$newpghost != ""} {
		set pghost $newpghost
		set db ""
		getdbs
	}
}

# start a new pg_browse view
proc newview {} {
	global db class
	exec pg_browse $db $class &
}

# create a new database on the current pghost
proc newdb {} {
	global pghost classes env
	set classes ""
	set newdb [entrydialog {New Database}]
	if {$newdb != ""} {
		working
		set env(PGHOST) $pghost
		addtolog "createdb $newdb"  "Shell Command"
		if [catch {exec createdb $newdb} err] {
			set errmsg "createdb failed for new database $newdb:\n\n$err"
			errorbox $errmsg
			addtolog "errmsg" FAILED!
			waiting
			return
		}
		addtolog "" SUCCESS
		waiting
		getdbs
	}
}

# create a new class in the current database
proc newclass {} {
	global db newclass classes newclasstypes typname 
	if {$db == ""}  {
		noticebox "Please select a database first."
		return
	}
	if {[set newclass [entrydialog {New Class}]] == "" } {
		return
	}
	if {[lsearch $classes $newclass] >= 0} {
		noticebox "Class $newclass already exists in database $db"
		return
	}
	toplevel .cclass
	wm title .cclass "Create Class $newclass"

	mkmenubar .cclass.menu {
		{ {About Adding a Class} {Build up your new class, attribute by attribute, by double clicking on the desired attribute type in the first (leftmost) box.  When finished, select "Execute" from the "File" menu to send the "postquel" command.} }
		{ {Adding Attributes} {To add an attribute, double click on the desired type in the first (leftmost) box.  You will be prompted for the new attribute's name.} }
		{ {Deleting Attributes} {To delete an attribute, double click on its entry in the second (middle) box.} } 
		} {
		File	{
			{ Execute execute_create_class {Sends the Postquel CREATE command to Postgres.} }
			{ Cancel cancel_create_class {Exits the "Create Class" dialog, discarding the new class.} }
			}
		}
	set namecmd { addattribute [selection get] }
	set delcmd { delattribute [selection get] }
	frame .cclass.boxes -bd 2 -relief raised
	mklistbox .cclass.boxes.types {
		.cclass.e.t delete 0 end
		.cclass.e.t insert 0 [selection get]
	}
	.cclass.boxes.types.t conf -text "Types"
	mklistbox .cclass.boxes.added $delcmd
	.cclass.boxes.added.t conf -text "Class $newclass"
#	mklistbox .cclass.boxes.msg {}
#	.cclass.boxes.msg.t conf -text "Postquel"
	frame .cclass.boxes.msg 
	label .cclass.boxes.msg.l -text "Postquel" -width 25
	message .cclass.boxes.msg.m -aspect 300 -font fixed -justify left
	pack append .cclass.boxes.msg \
		.cclass.boxes.msg.l top \
		.cclass.boxes.msg.m { left fill padx 5 pady 5 }
	pack append .cclass.boxes \
		.cclass.boxes.types left \
		.cclass.boxes.added left \
		.cclass.boxes.msg { top fillx }
	pack append .cclass \
		.cclass.menu { top fillx } \
		.cclass.boxes top 
	frame .cclass.e
	label .cclass.e.l -text "Add..."
	frame .cclass.e.r
	radiobutton .cclass.e.r.scalar -variable dims -value 0 -text "a scalar..." -relief flat -state active
	radiobutton .cclass.e.r.array -variable dims -value 1 -text "an array of..." -relief flat -state normal
	pack append .cclass.e.r \
		.cclass.e.r.scalar {frame w top } \
		.cclass.e.r.array {frame w top }
	label .cclass.e.t -relief sunken -bd 1 -width 20
	entry .cclass.e.e -relief sunken -bd 2 -width 20
	pack append .cclass.e \
		.cclass.e.l {left frame e} \
		.cclass.e.r {left frame w} \
		.cclass.e.t {left frame e} \
		.cclass.e.e {left frame w}
	pack append .cclass \
		.cclass.e {bottom frame w padx 5m pady 5m}
	
	fillbox .cclass.boxes.types.ls.l [lsort [array names typname]]
	tkwait window .cclass
}
proc cancel_create_class {} {
	global newclasstypes newclassdims
	if {![nnewatts] || [yesno "Exit now and abandon your new class?" n] } {
		catch {unset newclasstypes}
		catch {unset newclassdims}
		destroy .cclass
	}
}
proc execute_create_class {} {
	global newclasstypes db newclassdims newclass
	if ![nnewatts] {
		noticebox "You haven't added any attributes yet."
		return
	}

	destroy .cclass
	set cmd [create_class_cmd]
	working
	if [DoMonitor "$cmd" dmret] {
		waiting
		showclasses $db
		showattributes $newclass
	} else {
		waiting
		errorbox "Create class failed for class $newclass; Postgres error:\n\n$dmret"
	}
	unset newclasstypes
	unset newclassdims
}
proc nnewatts { } {
	global newclasstypes
	if ![info exists newclasstypes] {
		set n 0
	} else {
		set n [array size newclasstypes]
	}
	return $n
}
proc create_class_cmd { } {
	global newclasstypes newclass typname newclassdims
	if {[nnewatts] == 0} {
		return ""
	}
	set msg "create $newclass ("
	foreach name [lsort [array names newclasstypes]] {
		if $newclassdims($name) {
			set type $typname($newclasstypes($name))\[\]
		} else {
			set type $typname($newclasstypes($name))
		}
		set msg "$msg\n  ${name}=$type,"
	}
	set msg "[string range $msg 0 [expr [string length $msg]-2]]\n)"
	return "$msg"
}
proc fillpostquelmsg {} {
#	clearbox .cclass.boxes.msg.ls.l
#	fillbox .cclass.boxes.msg.ls.l [split [create_class_cmd] \n]
	.cclass.boxes.msg.m conf -text [create_class_cmd]
}
proc delattributes { selection } {
	global newclasstypes newclassdims
	set cur [.cclass.boxes.added.ls.l curselection]
	set name [lindex [split [lindex $selection 0] ,] 0]
	if ![yesno "Delete attribute $name?" y] {
		return
	}
	unset newclasstypes($name)
	unset newclassdims($name)
	.cclass.boxes.added.ls.l delete $cur
	fillpostquelmsg
}
proc addattribute { typedescrip } {
	global newclasstypes newclassdims dims
	set descrip [lindex $typedescrip 0]
	if {[set name [string trim [entrydialog "Name for $descrip" {} {New Attribute} ]]] == ""} {
		return
	}
	if [info exists newclasstypes($name)] {
		noticebox "Attribute $name has already been defined."
		return
	}
	if [regexp {^[^a-zA-Z]|\ } $name]  {
		errorbox "Invalid Name: \"$name\".  Attribute names must begin with an alphabetic character and contain no white space."
		return
	}
	
	set newclassdims($name) $dims
	set newclasstypes($name) $descrip
#	.cclass.boxes.added.ls.l insert end "$name, $descrip"
	filladdedbox
	fillpostquelmsg
}
proc filladdedbox { } {
	global newclasstypes
	clearbox .cclass.boxes.added.ls.l
	foreach name [lsort [array names newclasstypes]] {
		lappend nn "$name, $newclasstypes($name)"
	}
	fillbox .cclass.boxes.added.ls.l $nn
}

# call terry figel's make_gui script to create a
# tk query/add script

proc pg_makegui2 {} {
    global pghost db class attnames atttypes
    pg_gui $pghost $db $class $attnames $atttypes
}

proc pg_makegui {} {
	global db class attnames atttypes
	set fp_out [ open /tmp/$db.$class.in w ]
	puts $fp_out "db $db"
	puts $fp_out "class $class"
	puts $fp_out "attnames $attnames"
	puts $fp_out "atttypes $atttypes"
	close $fp_out
	exec pg_guibuilder < /tmp/$db.$class.in > /tmp/$db.$class.wish
	exec chmod a+x /tmp/$db.$class.wish
	exec /tmp/$db.$class.wish &
	exec rm /tmp/$db.$class.in
}



# show a few photos taken by steve miley
proc sequoia_pix {} {
        global pgbrowsedir
	if {[set xv [SearchPath xv /usr/bin/X11]] != ""} {
		exec $xv -wait 4  \
			${pgbrowsedir}/images/redwood \
			${pgbrowsedir}/images/sequoia.kings_canyon &
	} else {
		noticebox {Sorry - couldn't find the "xv" image display program in your PATH}
	}
}



# Procedures defined, build up the . window...

a56 13
proc working { } {
	setworking .info
	if [winfo exists .showlog] { setworking .showlog }
}
proc waiting { } {
	setwaiting .info
	if [winfo exists .showlog] { setwaiting .showlog}
}

proc call_pg_edit {} {
	global pg_edit db
	exec pg_edit $pghost $db &
}
d72 2
d119 3
a121 4
proc usageexit {} {
	puts stderr {Usage: pg_browse -showlog -logfile <logfile> [db] [class]}
	exit
}
a122 1
# Procedure definitions
d148 1
a158 2

# wait for events...
@


1.11
log
@added log file, better new class stuff, more.
@
text
@a63 1
set executeok ""
d96 1
a96 1
	noticebox "GLUEDIR $gluedir does not exists - you won't be able to perform any actions on retrieved data."
d316 2
a329 1
	waiting
d335 9
d353 1
a353 1
$typdescrip($type)
d399 1
a399 1
	global db newclass class classes env
d407 1
a407 1
	if {[lsearch $classes $newclass] > 0} {
a410 8
	if {![create_class] } {
		return
	}
	showclasses $db
	showattributes $newclass
}
proc create_class { } {
	global db newclass classes newclasstypes typname executeok
d420 1
a420 1
			{ Execute execute_create_class {Sends the Postquel command to Postgres.} }
d427 4
a430 2
	set bxl [array size typname]
	mklistbox .cclass.boxes.types $namecmd 20 $bxl
d432 1
a432 1
	mklistbox .cclass.boxes.added $delcmd 20 $bxl
d434 1
a434 1
#	mklistbox .cclass.boxes.msg {} 20 $bxl
d449 18
a468 10
	if ![nnewatts] {
		return 0
	}
	set cmd [create_class_cmd]
	if ![DoMonitor "$cmd" dmret] {
		errorbox "Create class failed for class $newclass; Postgres error:\n\n$dmret"
		return 0
	}
	infobox "Postgres return:\n\n$dmret"
	return 1
d471 1
a471 1
	global newclasstypes
d473 2
a474 1
		unset newclasstypes
d479 13
a491 2
	if [nnewatts] {
		destroy .cclass
d493 2
a494 1
		noticebox "You haven't added any attributes yet."
d496 2
d509 1
a509 1
	global newclasstypes newclass typname
d515 5
a519 1
		set type $typname($newclasstypes($name))
d531 1
a531 1
	global newclasstypes
d538 1
d543 1
a543 1
	global newclasstypes
d545 1
a545 1
	if {[set name [string trim [entrydialog "Name for $descrip"]]] == ""} {
d556 2
@


1.10
log
@Added the call to pg_guibuilder2
This version includes the Sequoia logo, does range checking
Asks you for a file name to save to or Deletes it
@
text
@d3 1
a3 1
# to root of the pg_browse goodies...
d6 9
d17 10
d29 1
d33 3
d38 1
a38 1

a42 1

a43 2
source ${scriptsdir}/tkutils
# source the tk utilities (The tcl query tool builder)
d46 9
d57 2
a58 2
set db [lindex $argv 0]
set class [lindex $argv 1]
d64 2
a69 1
       	set env(PGHOST) $pghost
d72 2
a73 1
# read in the pg types
d75 7
a81 8
	puts stdout "Can't find the types database:"
	puts stdout "	$scriptsdir/pgtypes"
	puts stdout "Can't continue."
}
set file [open $scriptsdir/pgtypes]
set i 0
while { ![eof $file] } {
	set line [gets $file]
d87 16
a102 3
			set pgtypes($i) [lindex $line 0]
			set pgnames($i) [lindex $line 1]
			incr i 1
d104 35
a139 1
close $file
d141 60
a200 1
# Procedure definitions
d205 1
a205 1
	global pghost dbs errorCode classes class
d211 2
a214 7
	catch { set dbs [lsort [exec listdbs template1 ]] }
	case [lindex $errorCode 0] in {
		{ CHILD* UNIX } {
			set class ""
			errorbox "Could not get database list on $pghost."
			}
		{ NONE } { }
d216 7
a222 2
		set class ""
		return
d224 2
a225 1

a226 2
	set classes ""
	set class ""
d230 1
d235 1
a235 2
	set db $d
	if { [lsearch $dbs $db] < 0 } {
d237 1
a237 1
		errorbox "No such database: $db"
d240 1
d250 5
a254 1
	catch { set classes [lsort [ exec classes $db ]] }
d263 2
a264 3
	set class $c
	if { [lsearch $classes $class] < 0 } {
		errorbox "No such class: $class"
d268 1
d276 14
a289 1
	set atts [join [lsort [ split [exec attributes $db $class] \n ] ] ]
d306 1
a306 1
	global db class pghost errorCode
d309 8
a316 6
	catch { set descrip [exec attdescrip $db $class $att] }
	case [lindex $errorCode 0] in {
		{ CHILD* UNIX } {
			set descrip "No description available."
			}
	}
d334 1
a334 4
	global db pghost class pgtypes pgnames
	foreach i [array names pgtypes] {
		if { $type == $pgtypes($i) } break
	}
d344 1
a344 1
$pgnames($i)
d351 1
a351 1
	global pghost env
d355 1
a355 1
		set env(PGHOST) "$pghost"
d368 1
a368 1
	global pghost classes
d373 10
a382 1
		exec createdb $newdb
d390 1
a390 2
	global db class classes pghost newatts newattnames env

d395 5
a399 5

	set prevclass $class
	set class [entrydialog {New Class}]
	if {$class == ""} {
		set class $prevclass
d402 1
a402 2
	if {[lsearch $classes $class] > 0} {
		noticebox "Class $class already exists in database $db"
a403 21
		}

	set nnew [create_class]
	if { $nnew != 0 } {
		working
		set filename /tmp/newclass.$env(USER)
		set file [open $filename w]
		foreach i [lsort [array names newatts]] {
			puts $file $newatts($i)
		}
		close $file
		catch { exec addclass $db $class < $filename }
		waiting
		showclasses $db
		if {[lsearch $classes $class] < 0} {
			errorbox "Create Class failed on class $class."
		} else {
			showattributes $class
		}
	} else {
		set class $prevclass
d405 2
d409 1
a409 6
	global db class classes newatts next_create \
		newattnames total_create pgnames
	set total_create 0
	set next_create 0
	catch { foreach i [array names newattnames] { unset newattnames($i) } }
	catch { foreach i [array names newatts] { unset newatts($i) } }
d411 1
a411 4
	wm title .cclass "Create Class $class"
	set namecmd { addattribute [.cclass.boxes.types.ls.l curselection] }
	set delcmd { delattribute [selection get] }
	set bxl [llength [array names pgnames]]
d413 9
a421 16
	frame .cclass.menu -relief raised -bd 2
	menubutton .cclass.menu.file -text "File" -menu .cclass.menu.file.m
	menu .cclass.menu.file.m
	.cclass.menu.file.m add command -label "Execute" \
		-command { destroy .cclass }
	.cclass.menu.file.m add command -label "Exit" \
		-command { 
			if {$total_create != 0} {
				set ans [yesno \
					"Exit now and abort your additions?" n]
				if {$ans == "yes"} {
					set total_create 0
					destroy .cclass
				}
			} else { destroy .cclass }
			
d423 2
a424 29
	menubutton .cclass.menu.help -text "Help" -menu .cclass.menu.help.m
	menu .cclass.menu.help.m
	.cclass.menu.help.m add command -label "About Adding a Class" \
		-command { helpbox {
Build up your new class, attribute by
attribute, by double clicking on the
desired attribute type in the first
(leftmost) box.  When finished, select
"Execute" from the "File" menu to send
the "postquel" command.  }
		}
	.cclass.menu.help.m add command -label "Adding Attributes" -command {
		helpbox {
To add an attribute, double click on
the desired type in the first
(leftmost) box.  You will be prompted
for the new attribute's name.  }
		}
	.cclass.menu.help.m add command -label "Deleting Attributes" -command {
		helpbox {
To delete an attribute, double click on
its entry in the second (middle) box.
}
		}

	pack append .cclass.menu \
		.cclass.menu.file { padx 10 left } \
		.cclass.menu.help { padx 10 right }

d426 7
d434 2
a435 2
	label .cclass.boxes.msg.l -text "postquel" -width 25
	message .cclass.boxes.msg.m -anchor w -justify left -font fixed
d438 1
a438 5
		.cclass.boxes.msg.m { top fill }
	mklistbox .cclass.boxes.types $namecmd 20 $bxl
	mklistbox .cclass.boxes.added $delcmd 20 $bxl
	.cclass.boxes.types.t conf -text "types"
	.cclass.boxes.added.t conf -text "$class"
d442 1
a442 2
		.cclass.boxes.msg { right fill }
	frame .cclass.b -bd 2 -relief raised
d445 26
a470 5
		.cclass.boxes top \
		.cclass.b top
	set names ""
	foreach i [lsort [array names pgnames]] {
		set names "$names \{ $pgnames($i) \}"
d472 9
a480 4
	fillbox .cclass.boxes.types.ls.l $names
	focus .cclass.boxes.types.ls.l
	tkwait window .cclass
	return $total_create
d483 8
a490 10
	global newatts class total_create
	if {$total_create == 0} {
		set msg ""
	} else {
		set msg "create $class (\n"
		foreach i [lsort [array names newatts]] {
			regsub " " $newatts($i) "=" line 
			set msg "$msg	$line,\n"
		}
		set msg "[string range $msg 0 [expr [string length $msg]-3]]\n)"
d492 1
d495 3
a497 13
proc delattributes { name } {
	global newatts newattnames total_create
	foreach index [array names newatts] {
		set n \{$newatts($index)\}
		if {$name == $n } break
	}
	set att [lindex $newatts($index) 0]
	set yesno [yesno "Delete attribute $att?" y]
	if {$yesno != "yes"} return
	unset newattnames($index)
	unset newatts($index)
	incr total_create -1
	.cclass.boxes.added.ls.l delete $index
d500 20
a519 11
proc addattribute { typei } {
	global newatts newattnames total_create next_create pgtypes
	set name [entrydialog "$pgtypes($typei) Attribute Name"]
	if { $name == "" } return
	if { $total_create > 0 } {
		foreach i [array names newattnames] {
			if { $name == $newattnames($i) } {
				noticebox "Attribute $name has already been defined."
				return
			}
		}
d521 2
a522 3
	if [regexp " " $name]  {
		errorbox "Invalid Attribute Name: $att\n
Attribute cannot have imbedded spaces "
d524 13
a536 7
		}
	set newatts($next_create) "$name $pgtypes($typei)"
	set newattnames($next_create) $name
	.cclass.boxes.added.ls.l insert end $newatts($next_create)
	incr next_create 1
	incr total_create 1
	.cclass.boxes.msg.m conf -text [create_class_cmd]
d541 1
d561 2
d566 7
a572 3
	exec xv -wait 4  \
		${pgbrowsedir}/images/redwood \
		${pgbrowsedir}/images/sequoia.kings_canyon &
d588 8
a595 2
proc working { } { setworking .info }
proc waiting { } { setwaiting .info }
d597 4
d603 7
a609 76
frame .menu -relief raised -bd 2
menubutton .menu.file -text "File" -menu .menu.file.m
menu .menu.file.m
.menu.file.m add command -label "Set PGHOST" -command pghostdialog
.menu.file.m add command -label "New View" -command newview
.menu.file.m add command -label "New Database" -command newdb
.menu.file.m add command -label "New Class: integrated" \
	-command newclass
.menu.file.m add command -label "New Class: standalone" -command { 
	exec pg_edit $pghost $db & }
.menu.file.m add command -label "Create Query Tool" -command pg_makegui
.menu.file.m add command -label "Create Query Tool2" -command pg_makegui2
.menu.file.m add command -label "Sequoia Pictures" -command sequoia_pix
.menu.file.m add command -label "Quit" -command {destroy .} 

menubutton .menu.help -text "Help" -menu .menu.help.m
menu .menu.help.m
.menu.help.m add command -label "About pg_browse" -command {
	helpbox {
Pg_browse allows you to browse through
databases stored on any postgres
server.

1. First, select a database by double
clicking in the first (leftmost) box or
create a new database by selecting "New
Database" in the "File" menu.

2.  Next, select or create a class by
double clicking in the second box or
seleting "New Class" under "File.

3.  Finally, select "Create Query Tool"
to query and/or add to the selected
class. }
	}

.menu.help.m add command -label "Bugs/Missing Features" -command {
	helpbox {
o  This beta release of Pg_browse has
very little error checking - keep an
eye on the window in which it was
started for messages.

o  There needs to be a way to build up
a Postquel COPY command to load in
instances into a newly created class.

o  Pg_browse breaks down if you somehow
"select" more than one entry in a
listbox - this is hard to do but can
happen and will often leave one or more
of the myriad of global variables
hosed.

o  You should be able to edit the
Postquel command which is built up in
the "New Class" window before sending
it to Postgres.

o  New View shouldn't have to reissue
all those queries to get back to the
point of the parent view.

o  "Create Query Tool" creates a TK
script and then runs it - you should be
prompted whether you want to save this
file to be run stand alone at a later
date.

}
	}


.menu.help.m add command -label "Set PGHOST" -command {
	helpbox {
d613 16
a628 1
defaults to heel.s2k.berkeley.edu }
d630 1
a630 37


.menu.help.m add command -label "New View" -command {
	helpbox {
Allows the user to create another
pg_browse window. }
	}

.menu.help.m add command -label "New Database" -command {
	helpbox {
Allows the user to create a new
database on the current Postgres
server.  You must have createdb
privilege for this to work.}
	}

.menu.help.m add command -label "New Class: integrated" -command {
	helpbox {
Jim Davidson's version of how to create
a new class within pg_browse. }
	}

.menu.help.m add command -label "New Class: standalone" -command {
	helpbox {
Terry Figel's versions of how to create
classes which can operate outside of
pg_browse. }
	}

.menu.help.m add command -label "Create Query Tool" -command {
	helpbox {
Creates a User Interface for the
current database and class allowing you
to retrieve and append data. This tool
will ultimately have hooks to 3rd party
packages such as S, IDL, AVS, etc.
	} }
a631 20
.menu.help.m add command -label "Sequoia Pictures" -command {
	helpbox {
A few pictures taken on Steve Miley's
vacation to Sequoia Kings Canyon
including a well known Sequoia tree and
a picture of Kings Canyon.  These
images are not currently coming out of
postgres - there here just for fun. }
	}


.menu.help.m add command -label "Quit" -command {
	helpbox {
Exits the application. }
	}

pack append .menu \
	.menu.file { padx 10 left } \
	.menu.help { padx 10 right }

d661 28
d690 2
d694 8
a701 2
if { $db != "" } { showclasses $db }
if { $class != "" } { showattributes $class }
@


1.9
log
@picked some bugs with setting the global
classes variable (expect more) and added a few
comments
@
text
@d23 2
d26 1
d412 5
d468 1
@


1.8
log
@added error checking in getdbs and showattdescrip
@
text
@a3 1

d7 1
a7 1
	set pgbrowsedir /usr/local/postgres/contrib/pg_browse
d10 1
d21 1
d39 2
a40 2
# read in pg types
if { ![file exists $pgbrowsedir/pgtypes] } {
d42 1
a42 1
	puts stdout "	$pgbrowsedir/pgtypes"
d45 1
a45 1
set file [open $pgbrowsedir/pgtypes]
d63 2
d66 1
a66 1
	global pghost dbs errorCode
d87 2
d92 2
a95 1
#	set db [selection get]
d116 2
a119 1
#	set class [selection get]
d148 1
a148 1

a150 1
#	set att [selection get]
d174 1
d194 1
d205 1
d211 1
d213 2
a214 1
	global pghost
d224 1
a255 2
		puts stdout "$classes"
		puts stdout "$class"
a264 1

a352 1

a366 1

a381 2
	

d407 2
d423 1
d433 1
a433 11
proc scriptdir { } {
	global env pgbrowsedir
	if ![file exists $pgbrowsedir] {
		set pgbrowsedir $env(HOME)
	}
	set dir [filedialog "Script Directory" $pgbrowsedir {} d]
	if { $dir != "" } {
		set env(PATH) "$env(PATH):$dir"
	}
	getdbs
}
d435 1
a435 1
# create info/progress box
d448 1
a448 2

# create menu bar
@


1.7
log
@many more changes, new info/warn/notice/help boxes, broken
out Help menus, working New Class: integrated, cleaned
up environment variables.
@
text
@a8 1
	set env(PGBROWSE) $pgbrowsedir
d14 2
d71 1
a71 1
	catch { set dbs [lsort [exec listdbs template1]] }
d75 1
a75 1
			errorbox "Could not get a list of available databases."
d143 1
a143 1
	global db class pghost
d147 6
d162 1
a162 1
[exec attdescrip $db $class $att]
d545 1
a545 1
priviliage for this to work.}
@


1.6
log
@added help and other stuff
@
text
@d3 1
a3 3
# some utilities
set HERE /home/src/base/local/tk/pg_browse
source ${HERE}/tkutils
d8 2
a9 1
	set pgbrowsedir ${HERE} 
d11 2
d14 1
d20 1
a29 2
set newatttypes ""
set newattnames ""
d38 6
a43 1
set file [open pgtypes]
d73 2
a74 12
			infobox error "

Error:

listdbs failed, TCL errorCode:

$errorCode

Try setting the \"Script Directory\"
in the \"File\" menu.

"
d77 3
a81 1
		
d92 1
a92 7
		infobox nodb "

No such database:

$db

"
d114 1
a114 7
		infobox noclass "

No such class:

$class

"
a124 1
#	set atts [exec attributes $db $class]
d146 1
a146 1
	infobox $att \
d161 6
a166 6
proc showtypedescrip { t } {
	global db pghost class
#	set type [selection get]
	set type $t
	working
	infobox $type \
d175 1
a175 1
[exec typedescrip $type]
a177 1
	waiting
d206 3
a208 2
proc call_pg_edit {} {
	global db class pghost newatttypes newattnames env
d210 3
a212 2
		infobox nodb \
"
d214 10
a223 1
You must first select a database.
d225 19
a243 2
"

d245 1
a245 25
		set prevclass $class
		set class [entrydialog {New Class}]
		if { $class != "" } {
			set class [create_class]
			if { $class != "" } {
				set nnames [llength $newattnames]
				set ntypes [llength $newattnames]
				if {$nnames != $ntypes} {
					infobox error { some weird error }
				}
				set filename /tmp/newclass.$env(USER)
				set file [open $filename w]
				for {set i 0} {$i<$nnames} {incr i 1 } {
					set n [lindex $newattnames $i]
					set t [lindex $newatttypes $i]
					puts $file "$n $t"
				}
				close $file
				exec addclass $db $class < $filename
				showclasses $db
				showattributes $class
			} else {
				set class $prevclass
			}
		}
d250 6
a255 3
	global db class pgnames newatttypes newattnames
	set newatttypes ""
	set newattnames ""
d257 67
a323 4
	mklistbox .cclass.types { 
		addattribute [.cclass.types.ls.l curselection]
	} 20 [llength [array names pgnames]]
	button .cclass.b -text OK -command { destroy .cclass }
d325 2
a326 1
		.cclass.types top \
d329 1
a329 1
	foreach i [array names pgnames] {
d332 2
a333 1
	fillbox .cclass.types.ls.l $names
d335 32
a366 1
	return "$class"
d368 1
d371 1
a371 1
	global newatttypes newattnames pgtypes
d374 8
d383 2
a384 10
		infobox badatt "

Error:

Bad name:  $name

Attribute names cannot have
imbedded spaces

"
d387 6
a392 2
	set newattnames [concat $newattnames $name]
	set newatttypes [concat $newatttypes $pgtypes($typei)]
d410 4
a413 3
        global HERE
        exec xv -wait 4 ${HERE}/images/redwood ${HERE}/images/sequoia.kings_canyon &

a415 36
proc pg_help {} {
 helpbox pgbrowse_help \
"Help:

This tool allows a user to browse
through databases stored on any postgres server.
By default, this version of pg_browse uses the Sequoia 2000
postgres server heel.s2k.berkeley.edu.

Set PGHOST: Allows the user to reset the postgres server.

New View: Allows the user to create another pg_browse window(possibly to
look at the locathost postgres server.

New Database: Allows the user to create a new database.

New Class: integrated with pg_browse: Jim Davidson's version of
how to create new classes within pg_browse

New Class: standalone: Terry Figel's versions of how to create
classes outside of pg_browse

Create Query Tool: Creates a User Interface for the database and class
selected, allowing the user to search and add data. This tool will ultimately
have hooks to 3rd party packages such as S, IDL, AVS, ...

Sequoia Pictures: A few pictures taken from my vacation
to Sequoia Kings Canyon.  A well known Sequoia tree and a
picture of the Sequoia Kings Canyon.  These images are not
currently coming out of postgres.


Quit: Exits the application.

"
}
d433 1
a433 1
label .info.bit -bitmap @@${HERE}/bitmaps/redwood
d451 4
a454 2
.menu.file.m add command -label "New Class: integrated with pg_browse" -command { call_pg_edit  }
.menu.file.m add command -label "New Class: standalone" -command { exec pg_edit  }
d461 118
a578 1
.menu.help.m add command -label "About pg_browse..." -command { pg_help }
@


1.5
log
@added more add class stuff, pgtypes file parser,
script directory selector, some more
@
text
@d4 2
a5 1
source /home/src/base/local/tk/pg_browse/tkutils
d10 1
a10 1
	set pgbrowsedir /home/src/base/local/tk/pg_browse
d317 3
d321 40
d376 1
a376 1
label .info.bit -bitmap @@/home/src/base/local/tk/pg_browse/bitmaps/redwood
a391 2
.menu.file.m add command -label "Set Script Directory" -command scriptdir
.menu.file.m add command -label "List Databases" -command getdbs
d394 2
a395 1
.menu.file.m add command -label "New Class" -command { call_pg_edit  }
d397 1
d402 1
a402 8
.menu.help.m add command -label "About pg_browse..." -command {
	infobox help \
"Help:

Sorry, there ain't no help...

"
}
@


1.4
log
@modified working/waiting proc and invocations
changed File menu labels
@
text
@d1 1
a1 1
#!/local/bin/wish -f
d3 2
d6 10
a15 1
# Global variables
d17 6
a22 3
wm geometry . +0+0
set db ""
set class ""
d26 2
d31 18
a48 1
       	set pghost localhost
d50 1
a50 1
set toplevels ""
d54 42
a95 3
proc fillbox { box tofill } {
	foreach i $tofill { $box insert end $i }
}
d97 1
a97 3
proc clearbox box {
	$box delete 0 end
}
d99 3
a101 21
proc mklistbox { frame tobind } {
	frame $frame
	label $frame.t -text ""
	frame $frame.ls
	listbox $frame.ls.l -yscroll "$frame.ls.s set" -relief sunken \
		-setgrid 1 -xscroll "$frame.ls.hs set"
	scrollbar $frame.ls.s -command "$frame.ls.l yview" 
	scrollbar $frame.ls.hs -command "$frame.ls.l xview" -orient hor 
	pack append $frame.ls \
		$frame.ls.hs { bottom fillx } \
		$frame.ls.s { right filly } \
		$frame.ls.l { top }
	pack append $frame \
		$frame.t { top fillx } \
		$frame.ls { top fill }
	bind $frame.ls.l <Double-Button-1> "$tobind"
}

proc showclasses {} {
	global db
	set db [selection get]
d103 1
a103 1
	working .info
d111 3
a113 2
	catch { fillbox .classes.ls.l [lsort [ exec classes $db ]] }
	waiting .info
d116 15
a130 3
proc showattributes {} {
	global db class atts attnames atttypes
	set class [selection get]
d132 1
a132 1
	working .info
d147 3
a149 41
	fillbox .atts.ls.l "$attnames"
	fillbox .types.ls.l "$atttypes"
	waiting .info
}

proc rev win {
	set b [$win configure -background ]
	set f [$win configure -foreground ]
	$win configure -background [lindex $f 4]
	$win configure -foreground [lindex $b 4]
}

proc newview {} {
	# this should be smarter
	exec pg_browse &
}

proc working { w } {
	rev $w.progress
	$w.progress configure -text "Working..."
	update
}

proc waiting { w } {
	rev $w.progress
	$w.progress configure -text ""
	update
}

proc tab args {
	set tablist $args
	set cur [lsearch $tablist [focus]]
	set next [expr $cur+1]
	if {$next >= [llength $tablist]} {
		set next 0
	}
	set curw [lindex $tablist $cur]
	set nextw [lindex $tablist $next]
	$curw conf -state normal
	catch { $nextw conf -state active }
	focus $nextw
a152 43
proc pghostdialog {} {
	global pghost highlight
	set pad "padx 10 pady 10"
	toplevel .pghost
	frame .pghost.b
	button .pghost.b.bok -text OK -command setpghost 
	button .pghost.b.bcancel -text Cancel -command {destroy .pghost}
	pack append .pghost.b \
		.pghost.b.bok "left $pad" \
		.pghost.b.bcancel "left $pad"
	frame .pghost.le -relief raised -border 1
	label .pghost.le.l -text "PGHOST:"
	entry .pghost.le.e -relief sunken
	global lasttab
	set lasttab .pghost.le.e
	.pghost.le.e insert 0 "$pghost"
	bind .pghost.le.e <Return> setpghost
	bind .pghost.b.bok <Return> setpghost
	bind .pghost.b.bcancel <Return> {destroy .pghost}
	pack append .pghost.le \
		.pghost.le.l "left $pad" \
		.pghost.le.e "left $pad"
	pack append .pghost .pghost.le "top fill" .pghost.b "bottom fillx"

	set tablist {.pghost.le.e .pghost.b.bok .pghost.b.bcancel}
	foreach f $tablist {
		bind $f <Tab> "tab $tablist"
	}
	focus .pghost.le.e
}

proc setpghost {} {
	global pghost env
	set pghost [.pghost.le.e get]
	catch {destroy .pghost}
	set env(PGHOST) "$pghost"
	foreach box { .classes .atts .types } {
		clearbox $box.ls.l
		$box.t configure -text ""
	}
	getdbs
}

a153 9
proc getdbs {} {
	global pghost env
	clearbox .dbs.ls.l
	delalltoplevels
	.dbs.t configure -text "$pghost"
	working .info
	fillbox .dbs.ls.l [lsort [exec listdbs template1]]
	waiting .info
}
d155 1
a155 1
proc showattdescrip {} {
d157 4
a160 3
	set att [selection get]
	working .info
	toplevelInfoBox $att \
d172 1
a172 1
	waiting .info
d175 1
a175 1
proc showtypedescrip {} {
d177 4
a180 3
	set type [selection get]
	working .info
	toplevelInfoBox $type \
d192 66
a257 1
	waiting .info
d260 15
a274 29
proc toplevelInfoBox { window msg } {
	global toplevels
	set win [string tolower $window]
	set toplevels [concat $toplevels .$win]
	toplevel .$win
	frame .$win.t -relief raised -bd 2
#	label .$win.t.l -bitmap info
	label .$win.t.l -text i -font "-adobe-courier-bold-r-*-*-*-240-*" \
		-background blue -foreground white
	message .$win.t.m -text "$msg" -aspect 200 -width 300
	pack append .$win.t \
		.$win.t.l { left padx 30 pady 30 } \
		.$win.t.m { left fill }
	button .$win.b -text "OK" -command "deltoplevel .$win"
	pack append .$win \
		.$win.t {top fill} \
		.$win.b {top pady 20 }
}
proc deltoplevel win {
	global toplevels
	destroy $win
	set i [lsearch $toplevels $win]
	set toplevels [lreplace $toplevels $i $i]
}

proc delalltoplevels {} {
	global toplevels
	foreach t $toplevels {
		destroy $t
d276 24
a299 1
	set toplevels ""
d302 26
a327 1
# create info box
d329 1
d332 2
d335 2
d338 2
a343 1

a344 2
pack append . .menu { top fillx } .info { top fillx }

d348 2
d351 1
d353 1
a353 1
.menu.file.m add command -label "Query" -command pg_makegui
d359 1
a359 1
	toplevelInfoBox help \
d366 7
a372 1
pack append .menu .menu.file { padx 10 left } .menu.help { padx 10 right }
d378 4
a381 4
mklistbox .dbs showclasses
mklistbox .classes showattributes
mklistbox .atts showattdescrip
mklistbox .types showtypedescrip
d392 5
a396 1
pack append . .dbs $where .classes $where .atts $where .types $where
a397 1
getdbs
a398 2
bind . <p> pghostdialog
bind . <q> {destroy .}
d400 4
a403 23




proc call_pg_edit {} {
	global db class pghost
	working .info
if {$db == ""}  {
	toplevelInfoBox FOO \
"

You must select a database first
this may require double clicking the database


"

	waiting .info
} else {
       	exec pg_edit $pghost $db &
}
}

d405 1
a405 14

proc pg_makegui {} {
	global db class attnames atttypes
	set fp_out [ open /tmp/$db.$class.in w ]
	puts $fp_out "db $db"
	puts $fp_out "class $class"
	puts $fp_out "attnames $attnames"
	puts $fp_out "atttypes $atttypes"
	close $fp_out
	pg_guibuilder < /tmp/$db.$class.in > /tmp/$db.$class.wish
	chmod a+x /tmp/$db.$class.wish
	exec /tmp/$db.$class.wish &
	exec rm /tmp/$db.$class.in
}
@


1.3
log
@*** empty log message ***
@
text
@d51 1
a51 1
	working
d60 1
a60 1
	waiting
d67 1
a67 1
	working
d84 1
a84 1
	waiting
d99 3
a101 3
proc working {} {
	rev .info.progress
	.info.progress configure -text "Working..."
d105 3
a107 3
proc waiting {} {
	rev .info.progress
	.info.progress configure -text ""
d175 1
a175 1
	working
d177 1
a177 1
	waiting
d183 1
a183 1
	working
d196 1
a196 1
	waiting
d202 1
a202 1
	working
d215 1
a215 1
	waiting
d269 3
a271 3
.menu.file.m add command -label "pg_makegui" -command pg_makegui
.menu.file.m add command -label "pg_edit" -command { call_pg_edit  }
.menu.file.m add command -label "Exit" -command {destroy .} 
d316 1
a316 1
	working
d327 1
a327 1
	waiting
d329 1
a329 1
       	exec pg_edit &
@


1.2
log
@terry's version
@
text
@d270 1
a270 1
.menu.file.m add command -label "pg_edit" -command { exec pg_edit & }
d314 6
d321 11
@


1.1
log
@Initial revision
@
text
@d1 1
a1 1
#!/usr/local/wish -f
d6 1
d269 2
a270 1
.menu.file.m add command -label "Dump Attribute List" -command dumpshit
d318 1
a318 1
proc dumpshit {} {
d320 10
a329 4
	puts stdout "db $db"
	puts stdout "class $class"
	puts stdout "attnames $attnames"
	puts stdout "atttypes $atttypes"
@
