preventing accelerators from inserting into text widget

I use a ctrl-s accelerator to save the contents of a text widget, but
I can't prevent the ctrl-s character from inserting into the text. How
can I do this?

fossildoc wrote:
> I use a ctrl-s accelerator to save the contents of a text widget, but
> I can't prevent the ctrl-s character from inserting into the text. How
> can I do this?

use strict;
use warnings;

use Tk;
my $mw = tkinit;
my $t = $mw->Text->pack;
$t->bindtags(['MyTag',$t->bindtags]);
$mw->bind('MyTag', '<Control-s>', \&save);

MainLoop;

sub save{
print "saving\n";
Tk::break;
}

HTH, Christoph


--
use Tk;use Tk::GraphItems;$c=tkinit->Canvas->pack;push@i,Tk::GraphItems->
TextBox(text=>$_,canvas=>$c,x=>$x+=70,y=>100)for(Just=>another=>Perl=>Hacker
);
Tk::GraphItems->Connector(source=>$i[$_],target=>$i[$_+1])for(0..2);
$c->repeat(30,sub{$_->move(0,4*cos($d+=3.16))for(@i)});MainLoop

On Feb 28, 4:03=A0am, Ch Lamprecht <ch.l.n...@online.de> wrote:
> fossildoc wrote: 
>
> use strict;
> use warnings;
>
> use Tk;
> my $mw =3D tkinit;
> my $t =3D $mw->Text->pack;
> $t->bindtags(['MyTag',$t->bindtags]);
> $mw->bind('MyTag', '<Control-s>', \&save);
>
> MainLoop;
>
> sub save{
> =A0 =A0 =A0print "saving\n";
> =A0 =A0 =A0Tk::break;
>
> }
>
> HTH, Christoph
>
> --
> use Tk;use Tk::GraphItems;$c=3Dtkinit->Canvas->pack;push@i,Tk::GraphItems-
=
>
> TextBox(text=3D>$_,canvas=3D>$c,x=3D>$x+=3D70,y=3D>100)for(Just=3D>another=[/color
]
=3D>Perl=3D>Hacke=ADr);
> Tk::GraphItems->Connector(source=3D>$i[$_],target=3D>$i[$_+1])for(0..2);
> $c->repeat(30,sub{$_->move(0,4*cos($d+=3D3.16))for(@i)});MainLoop

I used this solution, plus some info I found in another post on
Subwidget, and came up with this:

my $text_widget =3D $tl_text_file->Scrolled(    # $tl_text_file is a
Toplevel; a separate one for each text widget
"Text",
-scrollbars =3D> "se",
-wrap =3D> 'word',
-tabs =3D> [qw/3/], # this feature does not work!
-background =3D> 'khaki',
);
$text_widget->pack(-expand =3D> 1, -fill =3D> 'both');

my $subwidget =3D $text_widget->Subwidget('scrolled');
# this comes from a post in comp.lang.perl.tk
$subwidget->bindtags(['MyTag',$subwidget->bindtags]);
$tl_text_file->bind('MyTag','<Control-Key-s>' =3D> [\&save_ctrls,
$tl_text_file]);
# ctrl-s will run save_ctrls() first
$tl_text_file->bind('MyTag','<KeyPress>' =3D> sub {
my $w =3D shift;
my $e =3D $w->XEvent;
return if($e->K ne 'Return' && $e->K ne 'BackSpace' && $e->K ne
'Delete'
&& $e->N > 65000); # don't mark dirty
if($text_widget->{'dirty'} =3D=3D 0) {  # not dirty
my $title =3D $tl_text_file->cget(-title);
$title .=3D '*';
$tl_text_file->configure(-title =3D> $title);
$text_widget->{'dirty'} =3D 1;  # set dirty
}
} );

This works exactly the way I want, until I create a second text widget
in a different Toplevel. When I press a key in textwidget #2, the
'dirty' asterisk appears in textwidget #1, and if I close textwidget
#2, textwidget #1 stays on the screen but becomes undefined in code.
Debugging indicates that the sub is retrieving variables from
textwidget #1 instead of #2 when I press keys in #2, even though the
sub above seems to be a valid closure.

Any help, please.

fossildoc wrote:
> On Feb 28, 4:03 am, Ch Lamprecht <ch.l.n...@online.de> wrote:
> 

> I used this solution, plus some info I found in another post on
> Subwidget, and came up with this:
>
>     my $text_widget = $tl_text_file->Scrolled(    # $tl_text_file is a
> Toplevel; a separate one for each text widget
>       "Text",
>       -scrollbars => "se",
>       -wrap => 'word',
>       -tabs => [qw/3/], # this feature does not work!
>       -background => 'khaki',
>       );
>     $text_widget->pack(-expand => 1, -fill => 'both');
>
>     my $subwidget = $text_widget->Subwidget('scrolled');
>       # this comes from a post in comp.lang.perl.tk
>     $subwidget->bindtags(['MyTag',$subwidget->bindtags]);
>     $tl_text_file->bind('MyTag','<Control-Key-s>' => [\&save_ctrls,
> $tl_text_file]);
>       # ctrl-s will run save_ctrls() first
>     $tl_text_file->bind('MyTag','<KeyPress>' => sub {
>       my $w = shift;
>       my $e = $w->XEvent;
>       return if($e->K ne 'Return' && $e->K ne 'BackSpace' && $e->K ne
> 'Delete'
>         && $e->N > 65000); # don't mark dirty
>       if($text_widget->{'dirty'} == 0) {  # not dirty
>         my $title = $tl_text_file->cget(-title);
>         $title .= '*';
>         $tl_text_file->configure(-title => $title);
>         $text_widget->{'dirty'} = 1;  # set dirty
>       }
>     } );
>
> This works exactly the way I want, until I create a second text widget
> in a different Toplevel. When I press a key in textwidget #2, the
> 'dirty' asterisk appears in textwidget #1, and if I close textwidget
> #2, textwidget #1 stays on the screen but becomes undefined in code.
> Debugging indicates that the sub is retrieving variables from
> textwidget #1 instead of #2 when I press keys in #2, even though the
> sub above seems to be a valid closure.
>
> Any help, please.

Hi,

where does $tl_text_file come from? How is the code above called?
A Tk - callback specified using an anon Array like [\&sub , $tl_text_file] w
ill
create a copy of $tl_text_file at creation time, whereas sub{sub($tl_text_fi
le)}
is a perl closure and will refer to $tl_text_file.

HTH, Christoph

--
use Tk;use Tk::GraphItems;$c=tkinit->Canvas->pack;push@i,Tk::GraphItems->
TextBox(text=>$_,canvas=>$c,x=>$x+=70,y=>100)for(Just=>another=>Perl=>Hacker
);
Tk::GraphItems->Connector(source=>$i[$_],target=>$i[$_+1])for(0..2);
$c->repeat(30,sub{$_->move(0,4*cos($d+=3.16))for(@i)});MainLoop

Brutally fcked teens at porntube:
http://amateur-video-sharing.com/watch?v=218571

Hi, Christoph -

Thanks again for responding. Below is the entire sub which contains
the problem. open_annotation_file() is a callback for a menu choice in
a "jpeg document window" Toplevel, whose address is passed to the sub.
Recall that when open_annotation_filie()is called a second time, a new
Toplevel and text widget are created and loaded with the appropriate
file, but that pressing a key while that second text widget's Toplevel
is active will cause the the anonymous sub to reference values from
the first text widget's Toplevel. There are no global variables. I
suspect the problem lies in the relationship between the Subwidget()
return value and bindtags(), neither of which I fully understand, as
the documentation is cryptic. I am running XP Home.

sub open_annotation_file
# opens any existing text file associated with this file
{
my ($tl,$force) = @_; # $force = 1 to force creation of file
my $ini_filename = $tl->{'ini_file_name'};
# This will have a value if there's a jpeg document loaded in the
window, but
# this file may not actually exist.
return 0 unless($ini_filename); # in case there's no document loaded
in the window

my $types = [
['text files',  '.txt', ],
['All Files',        '*',             ],
];
my $dir = $tl->{'ini_dir'}; # for debugger
my $text_filename;
if($debug) {
$text_filename=$debug_text_file;
}
else {
$text_filename = $tl->getOpenFile(
-filetypes => $types,
-title => 'select annotation file or Cancel to default',
-initialdir => $dir # (this is ignored on W98)
);
}
unless($text_filename) {  # user Cancelled to default
my ($name,$path,$suffix) = fileparse($tl-
>{'ini_file_name'},qr(\..*));
$text_filename = $path . $name . ".txt";  # text file, if any
}
# print "\$text_filename=$text_filename\n" if $debug;
$debug = 0; # turn off debug so we can load other document windows

# At this point $name_text contains the full path
# of the annotation file, whether explicity specified or if
constructed by
# default from the ini_file_name, which itself may not actually
exist.
# $name_text may or may not exist, which is tested next.

if(!(-e $text_filename) && $force == 1) { # the text file does not
exist and
# caller wants to force creation of a file
sysopen(FH,$text_filename,O_WRONLY | O_EXCL | O_CREAT)
|| die "cannot create $text_filename" ; # must not exist
syswrite(FH,"(new file)\n") || die ("cannot write to
$text_filename");
close FH;
}

if(-e $text_filename) { # yes, the text file exists (should be true
now)
# (this test is redundant in anticipation of some code to be
added later)
my ($name,$path,$suffix) = fileparse($text_filename,qr(\..*));

my $tl_text_file = $mw->Toplevel(
-title => $name . $suffix . ": " . $tl->{'sequence'},
);

$tl_text_file->{'text_file_name'} = $text_filename;
$tl_text_file->protocol('WM_DELETE_WINDOW',
[\&close_annotation_file,$tl_text_file]);
$tl_text_file->geometry("600x400+400+150");

my $menubar = $tl_text_file->Menu(  # yes, I know there's a more
elegant way of creating menus
-tearoff => 0
);  # main menubar for annotations window
my $file_menu = $menubar->cascade(
-label =>'File',
-tearoff => 0,
);
$file_menu->command(
-label => '~Save',
-command => [\&save_annotation_file, $tl_text_file],
-accelerator => 'Ctrl+S',
);
$file_menu->command(
-label => 'Save As...',
-command => [\&saveas_annotation_file, $tl_text_file],
);
$file_menu->separator();
$file_menu->command(
-label => 'Close',
-command => [\&close_annotation_file, $tl_text_file],
);
my $window_menu = $menubar->cascade(
-label => 'Window',
-tearoff => 0,
);
$window_menu->command(
-label => 'title',
-command => [\&change_annotation_title,$tl_text_file],
);
$tl_text_file->configure(-menu => $menubar);

my $text_widget = $tl_text_file->Scrolled(
"Text",
-scrollbars => "se",
-wrap => 'word',
-tabs => [qw/3/], # this feature does not work!
-background => 'khaki',
);
$tl->{'text_widget'} = $text_widget; # we use this for
synchronizing the
# text widget to the document page display
# Note that if we open a second text file on a document window,
the
# previous one(s) do not synchronize
$tl_text_file->{'text_widget'} = $text_widget;
$text_widget->pack(-expand => 1, -fill => 'both');

my $subwidget = $text_widget->Subwidget('scrolled');
# this comes from a post in comp.lang.perl.tk
$subwidget->bindtags(['MyTag',$subwidget->bindtags]);
# put MyTag ahead of the class, instance, toplevel, and all tags
$tl_text_file->bind('MyTag','<Control-Key-s>' => [\&save_ctrls,
$tl_text_file]);
# ctrl-s will run save_ctrls() first
$tl_text_file->bind('MyTag','<KeyPress>' => sub {
my $w = shift;
my $e = $w->XEvent;
return if($e->K ne 'Return' && $e->K ne 'BackSpace' && $e->K ne
'Delete'
&& $e->N > 65000); # don't mark dirty
if($text_widget->{'dirty'} == 0) {  # not dirty
#print "sub:subwidget=$subwidget\n"; # temporary
my $title = $tl_text_file->cget(-title);
$title .= '*';
$tl_text_file->configure(-title => $title);
#print "sub:\$tl_text_file=$tl_text_file\n"; # temporary

$text_widget->{'dirty'} = 1;  # set dirty
}
} );
# bindDump($subwidget);

open (FH, "<", $text_filename) || die "Could not open
$text_filename";
while (<FH> ) {
$text_widget->insert('end', $_);
}
close(FH);

$text_widget->{'dirty'} = 0;  # text is not dirty

if(Exists($text_widget)) {
my $mnref = $tl->{'member_names'};  # ref to member names array
my $rmn = $tl->{'current_member_number'};  # current member
number
my $membername = $mnref->[$rmn];
$membername =~ /(.*)\.jpg/; # remove suffix
my $pat = qr(^\$\$$1\s*$); # like $$vii, $$078; can have
trailing spaces
my $index = $text_widget->search(
-regexp => $pat,
"1.0",
);
if($index) {  # lines begin with number 1
$text_widget->see($index);
}
else {  # we didn't find it on the first pass
# we'll combine all this later if this section works
# TODO: fill in sync here, but be sure to include romans!
}
} # if(Exists($text_widget))

return 0; # indicates text file was opened
} # if(-e $text_filename)
else {  # $text_filename does not exist
return 1;  # indicates text file was not opened
}
}

fossildoc schrieb:
> Hi, Christoph -
>
> Thanks again for responding. Below is the entire sub which contains
> the problem. open_annotation_file() is a callback for a menu choice in

Hi,

that's far too much code... And still not enough ;)
Does this behave the way you want:

Christoph

use strict;
use warnings;

use Tk;
my $mw = tkinit;
my @toplevels = map {$mw->Toplevel} (0..2);
for (@toplevels) {
my $t = $_->Text->pack;
my $title = "$t";
$_->configure(-title => $title);
$t->bindtags(['MyTag',$t->bindtags]);
$mw->bind('MyTag', '<Control-s>', \&save);
}
MainLoop;

sub save{
my $widget = shift;
print "save called for $widget\n";
Tk::break;
}