* library/center.tcl (center_window): Allow centering

	the toplevel on a window, too.

diff --git a/libgui/ChangeLog b/libgui/ChangeLog
index a5714db..5f3f09a 100644 (file)
--- a/libgui/ChangeLog
+++ b/libgui/ChangeLog
@@ -1,3 +1,8 @@
+2001-05-18  Keith Seitz  <keiths@cygnus.com>
+
+       * library/center.tcl (center_window): Allow centering
+       the toplevel on a window, too.
+
 2001-05-03  Keith Seitz  <keiths@cygnus.com>
 
        * src/tkWarpPointer.c (WarpPointer): Implement for windows.

diff --git a/libgui/library/center.tcl b/libgui/library/center.tcl
index c8f606a..93f51be 100644 (file)
--- a/libgui/library/center.tcl
+++ b/libgui/library/center.tcl
@@ -1,13 +1,23 @@
-# center.tcl - Center a window on the screen.
-# Copyright (C) 1997, 1998 Cygnus Solutions.
+# center.tcl - Center a window on the screen or over another window
+# Copyright (C) 1997, 1998, 2001 Red Hat, Inc.
 # Written by Tom Tromey <tromey@cygnus.com>.
 
 # Call this after the TOPLEVEL has been filled in, but before it has
-# been mapped.  This proc will center the toplevel on the screen.
-proc center_window {top} {
+# been mapped.  This proc will center the toplevel on the screen or
+# over another window.
+proc center_window {top args} {
+  parse_args {{over ""}}
+
   update idletasks
-  set x [expr {int (([winfo screenwidth $top] - [winfo reqwidth $top]) / 2)}]
-  set y [expr {int (([winfo screenheight $top] - [winfo reqheight $top]) / 2)}]
+  if {$over != ""} {
+    set cx [expr {int ([winfo rootx $over] + [winfo width $over] / 2)}]
+    set cy [expr {int ([winfo rooty $over] + [winfo height $over] / 2)}]
+    set x [expr {$cx - int ([winfo reqwidth $top] / 2)}]
+    set y [expr {$cy - int ([winfo reqheight $top] / 2)}]
+  } else {
+    set x [expr {int (([winfo screenwidth $top] - [winfo reqwidth $top]) / 2)}]
+    set y [expr {int (([winfo screenheight $top] - [winfo reqheight $top]) / 2)}]
+  }
   wm geometry $top +${x}+${y}
   wm positionfrom $top user