Received: from candle.pha.pa.us (pgman@nav-43.dsl.navpoint.com
 [162.33.245.46])
	by hub.org (8.10.1/8.10.1) with ESMTP id e6EL99040546
	for <pgsql-interfaces@postgresql.org>;
	Fri, 14 Jul 2000 17:09:09 -0400 (EDT)
Received: (from pgman@localhost) by candle.pha.pa.us (8.9.0/8.9.0) id RAA11066
	for pgsql-interfaces@postgresql.org;
	Fri, 14 Jul 2000 17:08:21 -0400 (EDT)
Received: from hub.org (root@hub.org [216.126.84.1])
	by candle.pha.pa.us (8.9.0/8.9.0) with ESMTP id QAA10185
	for <pgman@candle.pha.pa.us>; Fri, 14 Jul 2000 16:27:48 -0400 (EDT)
Received: from hub.org (majordom@localhost [127.0.0.1])
	by hub.org (8.10.1/8.10.1) with SMTP id e6EKS6031546;
	Fri, 14 Jul 2000 16:28:06 -0400 (EDT)
Received: from wallace.ece.rice.edu (wallace.ece.rice.edu [128.42.12.154])
	by hub.org (8.10.1/8.10.1) with ESMTP id e6EKRc031486
	for <pgsql-patches@postgresql.org>;
	Fri, 14 Jul 2000 16:27:38 -0400 (EDT)
Received: by rice.edu via sendmail from stdin
	id <m13DC3d-000LEJC@wallace.ece.rice.edu> (Debian Smail3.2.0.102)
	for pgsql-patches@postgresql.org; Fri, 14 Jul 2000 15:27:37 -0500 (CDT)
Date: Fri, 14 Jul 2000 15:27:37 -0500
From: "Ross J. Reedstrom" <reedstrm@rice.edu>
To: pgsql-patches@postgresql.org
Subject: [PATCHES] PgAccess schema-diagram cleanup
Message-ID: <20000714152737.A24031@rice.edu>
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="IS0zKkzwUGydFO0o"
User-Agent: Mutt/1.0i
X-Mailing-List: pgsql-patches@postgresql.org
Precedence: bulk
X-Archive-Number: 200007/96


--IS0zKkzwUGydFO0o
Content-Type: text/plain; charset=us-ascii

Here's a patch to clean up some issues with the schema diagram
editor in pgaccess. This patch:

	* allows schema window to be resized up to full screen size
	* autosizes window on schema open
	* allows multiselect of tables (by shift click) to allow
		dragging of sets of tables
		deletion of sets of tables
	* fixes a bug in table deletion code that did not delete
	  links to that table properly
	* changes link lines to be continous, so they export better
		via postscript->pstoedit->xfig
	
It does not change the name of the feature from schema, as I 
asked about on HACKERS. I'm off for a week's vacation starting
tomorrow, so I probably won't see any commentary on this until
Monday the 24th

Ross
-- 
Ross J. Reedstrom, Ph.D., <reedstrm@rice.edu> 
NSBRI Research Scientist/Programmer
Computer and Information Technology Institute
Rice University, 6100 S. Main St.,  Houston, TX 77005


--IS0zKkzwUGydFO0o
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="pgaccess.group.diff"

Index: bin/pgaccess//lib/schema.tcl
===================================================================
RCS file: /home/projects/pgsql/cvsroot/pgsql/src/bin/pgaccess/lib/schema.tcl,v
retrieving revision 1.5
diff -c -r1.5 schema.tcl
*** bin/pgaccess//lib/schema.tcl	2000/03/31 11:22:31	1.5
--- bin/pgaccess//lib/schema.tcl	2000/07/14 19:05:57
***************
*** 39,44 ****
--- 39,47 ----
  	}
  	set PgAcVar(schema,links) $links
  	drawLinks
+ 	foreach {ulx uly lrx lry} [.pgaw:Schema.c bbox all] {
+ 		wm geometry .pgaw:Schema [expr $lrx+30]x[expr $lry+30]
+ 	}
  }
  
  
***************
*** 100,106 ****
  	.pgaw:Schema.c lower rect
  	drawLinks
  
! 	.pgaw:Schema.c bind mov <Button-1> {Schema::dragStart %W %x %y}
  	.pgaw:Schema.c bind mov <B1-Motion> {Schema::dragMove %W %x %y}
  	bind .pgaw:Schema.c <ButtonRelease-1> {Schema::dragStop %x %y}
  	bind .pgaw:Schema <Button-1> {Schema::canvasClick %x %y %W}
--- 103,109 ----
  	.pgaw:Schema.c lower rect
  	drawLinks
  
! 	.pgaw:Schema.c bind mov <Button-1> {Schema::dragStart %W %x %y %s}
  	.pgaw:Schema.c bind mov <B1-Motion> {Schema::dragMove %W %x %y}
  	bind .pgaw:Schema.c <ButtonRelease-1> {Schema::dragStop %x %y}
  	bind .pgaw:Schema <Button-1> {Schema::canvasClick %x %y %W}
***************
*** 152,193 ****
  proc {deleteObject} {} {
  global PgAcVar
  # Checking if there 
! set obj [.pgaw:Schema.c find withtag hili]
! if {$obj==""} return
  # Is object a link ?
! if {[getTagInfo $obj link]=="s"} {
! 	if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:Schema -message [intlmsg "Remove link ?"] -type yesno -default no]=="no"} return
! 	set linkid [getTagInfo $obj lkid]
! 	set PgAcVar(schema,links) [lreplace $PgAcVar(schema,links) $linkid $linkid]
  	.pgaw:Schema.c delete links
  	drawLinks
- 	return
- }
- # Is object a table ?
- set tablealias [getTagInfo $obj tab]
- set tablename $PgAcVar(schema,tablename$tablealias)
- if {"$tablename"==""} return
- if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:Schema -message [format [intlmsg "Remove table %s from query?"] $tablename] -type yesno -default no]=="no"} return
- for {set i [expr [llength $PgAcVar(schema,links)]-1]} {$i>=0} {incr i -1} {
- 	set thelink [lindex $PgAcVar(schema,links) $i]
- 	if {($tablealias==[lindex $thelink 0]) || ($tablealias==[lindex $thelink 2])} {
- 		set PgAcVar(schema,links) [lreplace $PgAcVar(schema,links) $i $i]
  	}
  }
- for {set i 0} {$i<$PgAcVar(schema,ntables)} {incr i} {
- 	set temp {}
- 	catch {set temp $PgAcVar(schema,tablename$i)}
- 	if {"$temp"=="$tablename"} {
- 		unset PgAcVar(schema,tablename$i)
- 		unset PgAcVar(schema,tablestruct$i)
- 		break
- 	}
- }
- #incr PgAcVar(schema,ntables) -1
- .pgaw:Schema.c delete tab$tablealias
- .pgaw:Schema.c delete links
- drawLinks
- }
  
  
  proc {dragMove} {w x y} {
--- 155,199 ----
  proc {deleteObject} {} {
  global PgAcVar
  # Checking if there 
! set objs [.pgaw:Schema.c find withtag hili]
! set numobj [llength $objs]
! if {$numobj == 0 } return
  # Is object a link ?
! foreach obj $objs {
! 	if {[getTagInfo $obj link]=="s"} {
! 		if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:Schema -message [intlmsg "Remove link ?"] -type yesno -default no]=="no"} return
! 		set linkid [getTagInfo $obj lkid]
! 		set PgAcVar(schema,links) [lreplace $PgAcVar(schema,links) $linkid $linkid]
! 		.pgaw:Schema.c delete links
! 		drawLinks
! 		return
! 	}
! 	# Is object a table ?
! 	set tablealias [getTagInfo $obj tab]
! 	set tablename $PgAcVar(schema,tablename$tablealias)
! 	if {"$tablename"==""} return
! 	if {[tk_messageBox -title [intlmsg Warning] -icon question -parent .pgaw:Schema -message [format [intlmsg "Remove table %s from schema?"] $tablename] -type yesno -default no]=="no"} return
! 	for {set i [expr [llength $PgAcVar(schema,links)]-1]} {$i>=0} {incr i -1} {
! 		set thelink [lindex $PgAcVar(schema,links) $i]
! 		if {($tablename==[lindex $thelink 0]) || ($tablename==[lindex $thelink 2])} {
! 			set PgAcVar(schema,links) [lreplace $PgAcVar(schema,links) $i $i]
! 		}
! 	}
! 	for {set i 0} {$i<$PgAcVar(schema,ntables)} {incr i} {
! 		set temp {}
! 		catch {set temp $PgAcVar(schema,tablename$i)}
! 		if {"$temp"=="$tablename"} {
! 			unset PgAcVar(schema,tablename$i)
! 			unset PgAcVar(schema,tablestruct$i)
! 			break
! 		}
! 	}
! 	#incr PgAcVar(schema,ntables) -1
! 	.pgaw:Schema.c delete tab$tablealias
  	.pgaw:Schema.c delete links
  	drawLinks
  	}
  }
  
  
  proc {dragMove} {w x y} {
***************
*** 196,202 ****
  	set dx [expr $x - $PgAcVar(draginfo,x)]
  	set dy [expr $y - $PgAcVar(draginfo,y)]
  	if {$PgAcVar(draginfo,is_a_table)} {
! 		$w move $PgAcVar(draginfo,tabletag) $dx $dy
  		drawLinks
  	} else {
  		$w move $PgAcVar(draginfo,obj) $dx $dy
--- 202,208 ----
  	set dx [expr $x - $PgAcVar(draginfo,x)]
  	set dy [expr $y - $PgAcVar(draginfo,y)]
  	if {$PgAcVar(draginfo,is_a_table)} {
! 		$w move dragme $dx $dy
  		drawLinks
  	} else {
  		$w move $PgAcVar(draginfo,obj) $dx $dy
***************
*** 206,212 ****
  }
  
  
! proc {dragStart} {w x y} {
  global PgAcVar
  PgAcVar:clean draginfo,*
  set PgAcVar(draginfo,obj) [$w find closest $x $y]
--- 212,218 ----
  }
  
  
! proc {dragStart} {w x y state} {
  global PgAcVar
  PgAcVar:clean draginfo,*
  set PgAcVar(draginfo,obj) [$w find closest $x $y]
***************
*** 223,230 ****
  	set taglist [.pgaw:Schema.c gettags $PgAcVar(draginfo,obj)]
  	set PgAcVar(draginfo,tabletag) [lindex $taglist [lsearch -regexp $taglist "^tab\[0-9\]*"]]
  	.pgaw:Schema.c raise $PgAcVar(draginfo,tabletag)
! 	.pgaw:Schema.c itemconfigure [.pgaw:Schema.c find withtag hili] -fill black
! 	.pgaw:Schema.c dtag [.pgaw:Schema.c find withtag hili] hili
  	.pgaw:Schema.c addtag hili withtag $PgAcVar(draginfo,obj)
  	.pgaw:Schema.c itemconfigure hili -fill blue
  } else {
--- 229,240 ----
  	set taglist [.pgaw:Schema.c gettags $PgAcVar(draginfo,obj)]
  	set PgAcVar(draginfo,tabletag) [lindex $taglist [lsearch -regexp $taglist "^tab\[0-9\]*"]]
  	.pgaw:Schema.c raise $PgAcVar(draginfo,tabletag)
! 	if {$state == 0} {
! 		.pgaw:Schema.c itemconfigure hili -fill black
! 		.pgaw:Schema.c dtag hili
! 		.pgaw:Schema.c dtag dragme
! 	}
! 	.pgaw:Schema.c addtag dragme withtag $PgAcVar(draginfo,tabletag)
  	.pgaw:Schema.c addtag hili withtag $PgAcVar(draginfo,obj)
  	.pgaw:Schema.c itemconfigure hili -fill blue
  } else {
***************
*** 247,253 ****
  # Re-establish the normal paint order so
  # information won't be overlapped by table rectangles
  # or link lines
! .pgaw:Schema.c lower $PgAcVar(draginfo,obj)
  .pgaw:Schema.c lower rect
  .pgaw:Schema.c lower links
  set PgAcVar(schema,panstarted) 0
--- 257,267 ----
  # Re-establish the normal paint order so
  # information won't be overlapped by table rectangles
  # or link lines
! if {$PgAcVar(draginfo,is_a_table)} {
! 	.pgaw:Schema.c lower $PgAcVar(draginfo,tabletag)
! } else {
! 	.pgaw:Schema.c lower $PgAcVar(draginfo,obj)
! }
  .pgaw:Schema.c lower rect
  .pgaw:Schema.c lower links
  set PgAcVar(schema,panstarted) 0
***************
*** 327,352 ****
  			# Source object is on the left of target object
  			set x1 $sre
  			set y1 [expr ([lindex $sbbox 1]+[lindex $sbbox 3])/2]
- 			.pgaw:Schema.c create line $x1 $y1 [expr $x1+10] $y1 \
- 				-tags [subst {links lkid$i}] -width 3
  			set x2 [lindex $dbbox 0]
  			set y2 [expr ([lindex $dbbox 1]+[lindex $dbbox 3])/2]
! 			.pgaw:Schema.c create line [expr $x2-10] $y2 $x2 $y2 \
! 				-tags [subst {links lkid$i}] -width 3
! 			.pgaw:Schema.c create line [expr $x1+10] $y1 [expr $x2-10] $y2 \
! 				-tags [subst {links lkid$i}] -width 2
  		} else {
  			# source object is on the right of target object
  			set x1 [lindex $sbbox 0]
  			set y1 [expr ([lindex $sbbox 1]+[lindex $sbbox 3])/2]
- 			.pgaw:Schema.c create line $x1 $y1 [expr $x1-10] $y1 \
- 				-tags [subst {links lkid$i}] -width 3
  			set x2 $dre
  			set y2 [expr ([lindex $dbbox 1]+[lindex $dbbox 3])/2]
! 			.pgaw:Schema.c create line $x2 $y2 [expr $x2+10] $y2 -width 3 \
! 				-tags [subst {links lkid$i}]
! 			.pgaw:Schema.c create line [expr $x1-10] $y1 [expr $x2+10] $y2 \
! 				-tags [subst {links lkid$i}] -width 2
  		}
  		incr i
  	}
--- 341,362 ----
  			# Source object is on the left of target object
  			set x1 $sre
  			set y1 [expr ([lindex $sbbox 1]+[lindex $sbbox 3])/2]
  			set x2 [lindex $dbbox 0]
  			set y2 [expr ([lindex $dbbox 1]+[lindex $dbbox 3])/2]
! 			.pgaw:Schema.c create line $x1 $y1 [expr $x1+10] $y1 \
! 					[expr $x1+10] $y1 [expr $x2-10] $y2 \
! 					[expr $x2-10] $y2 $x2 $y2 \
! 					-tags [subst {links lkid$i}] -width 2
  		} else {
  			# source object is on the right of target object
  			set x1 [lindex $sbbox 0]
  			set y1 [expr ([lindex $sbbox 1]+[lindex $sbbox 3])/2]
  			set x2 $dre
  			set y2 [expr ([lindex $dbbox 1]+[lindex $dbbox 3])/2]
! 			.pgaw:Schema.c create line $x1 $y1 [expr $x1-10] $y1 \
! 					[expr $x1-10] $y1 [expr $x2+10] $y2 \
! 					$x2 $y2 [expr $x2+10] $y2 \
! 					-tags [subst {links lkid$i}] -width 2
  		}
  		incr i
  	}
***************
*** 405,412 ****
  global PgAcVar
  	set obj [.pgaw:Schema.c find closest $x $y 1 links]
  	if {[getTagInfo $obj link]!="s"} return
! 	.pgaw:Schema.c itemconfigure [.pgaw:Schema.c find withtag hili] -fill black
! 	.pgaw:Schema.c dtag [.pgaw:Schema.c find withtag hili] hili
  	.pgaw:Schema.c addtag hili withtag $obj
  	.pgaw:Schema.c itemconfigure $obj -fill blue
  }
--- 415,422 ----
  global PgAcVar
  	set obj [.pgaw:Schema.c find closest $x $y 1 links]
  	if {[getTagInfo $obj link]!="s"} return
! 	.pgaw:Schema.c itemconfigure hili -fill black
! 	.pgaw:Schema.c dtag hili
  	.pgaw:Schema.c addtag hili withtag $obj
  	.pgaw:Schema.c itemconfigure $obj -fill blue
  }
***************
*** 457,464 ****
  	set PgAcVar(schema,panobject) tables
  	if {$canpan} {
  		if {[.pgaw:Schema.c find withtag hili]!=""} {
! 			.pgaw:Schema.c itemconfigure [.pgaw:Schema.c find withtag hili] -fill black
! 			.pgaw:Schema.c dtag [.pgaw:Schema.c find withtag hili] hili
  		}
  
  		.pgaw:Schema configure -cursor hand1
--- 467,474 ----
  	set PgAcVar(schema,panobject) tables
  	if {$canpan} {
  		if {[.pgaw:Schema.c find withtag hili]!=""} {
! 			.pgaw:Schema.c itemconfigure hili -fill black
! 			.pgaw:Schema.c dtag hili
  		}
  
  		.pgaw:Schema configure -cursor hand1
***************
*** 482,488 ****
  	toplevel $base -class Toplevel
  	wm focusmodel $base passive
  	wm geometry $base 759x530+10+13
! 	wm maxsize $base 1280 1024
  	wm minsize $base 1 1
  	wm overrideredirect $base 0
  	wm resizable $base 1 1
--- 492,498 ----
  	toplevel $base -class Toplevel
  	wm focusmodel $base passive
  	wm geometry $base 759x530+10+13
! 	wm maxsize $base [winfo screenwidth .] [winfo screenheight .]
  	wm minsize $base 1 1
  	wm overrideredirect $base 0
  	wm resizable $base 1 1
***************
*** 558,566 ****
  	entry $base.f.esn \
  		-background #fefefe -borderwidth 1 -textvariable PgAcVar(schema,name) 
  	label $base.f.lsn -text [intlmsg {Schema name}]
- 	place $base.c  -x 5 -y 30 -width 748 -height 500 -anchor nw -bordermode ignore 
- 	place $base.f \
- 		-x 5 -y 5 -width 748 -height 25 -anchor nw -bordermode ignore 
  	pack $base.f.l \
  		-in .pgaw:Schema.f -anchor center -expand 0 -fill none -side left 
  	pack $base.f.e \
--- 568,573 ----
***************
*** 580,585 ****
--- 587,594 ----
  	pack $base.f.lsn \
  		-in .pgaw:Schema.f -anchor center -expand 0 -fill none -side right 
  
+ 	pack $base.f -side top -anchor ne -expand 0 -fill x
+ 	pack $base.c -side bottom -fill both -expand 1
  }
  
  

--IS0zKkzwUGydFO0o--