← Back to branch summary

~ubuntu-branches/ubuntu/natty/perl-tk/natty

« back to all changes in this revision

Viewing changes to Tk/Wm.pm

  • Committer: Bazaar Package Importer
  • Author(s): Stephen Zander
  • Date: 2004-03-14 13:54:44 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040314135444-prc09u2or4dbr3to
Tags: 1:800.025-2
http://bugs.debian.org/237942
Add xlibs-dev to Build-Depends:,
Closes: #237942

Show diffs side-by-side

added added

removed removed

Lines of Context:
Tk/Wm.pm
1
 
# Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
 
1
# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
2
2
# This program is free software; you can redistribute it and/or
3
3
# modify it under the same terms as Perl itself.
4
4
package Tk::Wm;
14
14
 
15
15
 
16
16
use vars qw($VERSION);
17
 
$VERSION = '3.023'; # $Id: //depot/Tk8/Tk/Wm.pm#23 $
18
 
 
19
 
use Tk::Submethods ( 'wm' => [qw(grid tracing)] );
 
17
$VERSION = '3.028'; # $Id: //depot/Tk8/Tk/Wm.pm#28 $
 
18
 
 
19
use Tk::Submethods;
 
20
 
 
21
*{Tk::Wm::wmGrid}    = sub { shift->wm("grid", @_) };
 
22
*{Tk::Wm::wmTracing} = sub { shift->wm("tracing", @_) };
20
23
 
21
24
Direct Tk::Submethods ('wm' => [qw(aspect client colormapwindows command
22
25
                       deiconify focusmodel frame geometry group
47
50
 $w->geometry($width.'x'.$height);
48
51
 $w->MoveToplevelWindow($x,$y);
49
52
 $w->deiconify;
50
 
}   
 
53
}
51
54
 
52
55
sub WmDeleteWindow
53
56
{
75
78
 $X = int($X);
76
79
 $Y = int($Y);
77
80
 $w->positionfrom('user');
78
 
 # $w->geometry("+$X+$Y");
79
 
 $w->MoveToplevelWindow($X,$Y);
 
81
 $w->geometry("+$X+$Y");
 
82
 # $w->MoveToplevelWindow($X,$Y);
80
83
 $w->deiconify;
81
84
 $w->raise;
82
85
}
123
126
  }
124
127
 my ($X,$Y) = AnchorAdjust($w->cget('-overanchor'),$rx,$ry,$rw,$rh);
125
128
 ($X,$Y)    = AnchorAdjust($w->cget('-popanchor'),$X,$Y,-$mw,-$mh);
126
 
 $w->Post($X,$Y); 
 
129
 # adjust to not cross screen borders
 
130
 if ($mw > $w->screenwidth)  { $X = 0 }
 
131
 if ($mh > $w->screenheight) { $Y = 0 }
 
132
 $w->Post($X,$Y);
127
133
 $w->waitVisibility;
128
134
}
129
135