view release on metacpan or  search on metacpan

lib/Tcl/pTk/Text.pm  view on Meta::CPAN

  {$ret_val=1;}
 return $ret_val;
}

########################################################################
sub FindAndReplaceAll
{
 my ($w,$mode, $case, $find, $replace ) = @_;
 $w->markSet('insert', '1.0');
 $w->unselectAll;
 while($w->FindNext('-forward', $mode, $case, $find))
  {
  $w->ReplaceSelectionsWith($replace);
  }
}



##################### Menu Functions ##############
## Originally in Tk::Text ###
sub MenuLabels
{
 return qw[~File ~Edit ~Search ~View];
}

sub SearchMenuItems
{
 my ($w) = @_;
 return [
    ['command'=>'~Find',          -command => [$w => 'FindPopUp']],
    ['command'=>'Find ~Next',     -command => [$w => 'FindSelectionNext']],
    ['command'=>'Find ~Previous', -command => [$w => 'FindSelectionPrevious']],
    ['command'=>'~Replace',       -command => [$w => 'FindAndReplacePopUp']]
   ];
}

sub EditMenuItems
{
 my ($w) = @_;
 my @items = ();
 foreach my $op ($w->clipEvents)
  {
   push(@items,['command' => "~$op", -command => [ $w => "clipboard$op"]]);
  }
 push(@items,
    '-',
    ['command'=>'Select All', -command   => [$w => 'selectAll']],
    ['command'=>'Unselect All', -command => [$w => 'unselectAll']],
  );
 return \@items;
}

sub ViewMenuItems
{
 my ($w) = @_;
 my $v;
# tie $v,'Tk::Configure',$w,'-wrap';
 return  [
    ['command'=>'Goto ~Line...', -command => [$w => 'GotoLineNumberPopUp']],
    ['command'=>'~Which Line?',  -command =>  [$w => 'WhatLineNumberPopUp']],
    ['cascade'=> 'Wrap', -tearoff => 0, -menuitems => [
      [radiobutton => 'Word', -variable => \$v, -value => 'word'],
      [radiobutton => 'Character', -variable => \$v, -value => 'char'],
      [radiobutton => 'None', -variable => \$v, -value => 'none'],
    ]],
  ];
}

# Workaround for compatibility with Perl/Tk search()
# (used by Tk::Text Find methods), which accepts
# abbreviated flags, whereas Tcl/Tk search() does not
#
# TODO: should this be rewritten as _expandSearchFlags
# and process e.g. $direction or $case as well?
sub _expandModeFlag {
  my $mode = shift;
  if (($mode =~ m{^-e}) &&
      ($mode eq substr("-exact", 0, length($mode)))) {
    $mode = '-exact';
  } elsif (($mode =~ m{^-r}) &&
      ($mode eq substr("-regex", 0, length($mode)))) {
    $mode = '-regex';
  }
  return $mode;
}

sub get {
    my $self = shift;
    # Note that empty string is returned (as done by Perl/Tk) rather than undef.
    return $self->interp->invoke($self->path, 'get', @_);
}

1;