Re: [RFA] Expand libgui to center on window

[Keith Seitz <keiths at cygnus dot com>]

On Fri, 18 May 2001, Keith Seitz wrote:

Checked in.

> ChangeLog:
> 2001-05-18  Keith Seitz  <keiths@cygnus.com>
>
> 	* library/center.tcl (center_window): Allow centering
> 	the toplevel on a window, too.
>
> Patch:
> Index: library/center.tcl
> ===================================================================
> RCS file: /cvs/src/src/libgui/library/center.tcl,v
> retrieving revision 1.1.1.1
> diff -u -p -r1.1.1.1 center.tcl
> --- library/center.tcl	2000/02/07 00:19:47	1.1.1.1
> +++ library/center.tcl	2001/05/18 21:05:37
> @@ -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
>
>
>
>