Tk

 view release on metacpan or  search on metacpan

Text/Text.pm  view on Meta::CPAN

 $mw->bind($class, '<3>', ['PostPopupMenu', Ev('X'), Ev('Y')]  );
 $mw->YMouseWheelBind($class);
 $mw->XMouseWheelBind($class);

 $mw->MouseWheelBind($class);

 return $class;
}

sub selectAll
{
 my ($w) = @_;
 $w->tagAdd('sel','1.0','end');
}

sub unselectAll
{
 my ($w) = @_;
 $w->tagRemove('sel','1.0','end');
}

sub adjustSelect
{
 my ($w) = @_;
 my $Ev = $w->XEvent;
 $w->ResetAnchor($Ev->xy);
 $w->SelectTo($Ev->xy,'char')
}

sub selectLine
{
 my ($w) = @_;
 my $Ev = $w->XEvent;
 $w->SelectTo($Ev->xy,'line');
 Tk::catch { $w->markSet('insert','sel.first') };
}

sub selectWord
{
 my ($w) = @_;
 my $Ev = $w->XEvent;
 $w->SelectTo($Ev->xy,'word');
 Tk::catch { $w->markSet('insert','sel.first') }
}

sub ClassInit
{
 my ($class,$mw) = @_;
 $class->SUPER::ClassInit($mw);

 $class->bindRdOnly($mw);

 $mw->bind($class,'<Tab>', 'insertTab');
 $mw->bind($class,'<Control-i>', ['Insert',"\t"]);
 $mw->bind($class,'<Return>', ['Insert',"\n"]);
 $mw->bind($class,'<Delete>','Delete');
 $mw->bind($class,'<BackSpace>','Backspace');
 $mw->bind($class,'<Insert>', \&ToggleInsertMode ) ;
 $mw->bind($class,'<KeyPress>',['InsertKeypress',Ev('A')]);

 $mw->bind($class,'<F1>', 'clipboardColumnCopy');
 $mw->bind($class,'<F2>', 'clipboardColumnCut');
 $mw->bind($class,'<F3>', 'clipboardColumnPaste');

 # Additional emacs-like bindings:

 if (!$Tk::strictMotif)
  {
   $mw->bind($class,'<Control-d>',['delete','insert']);
   $mw->bind($class,'<Control-k>','deleteToEndofLine') ;
   $mw->bind($class,'<Control-o>','openLine');
   $mw->bind($class,'<Control-t>','Transpose');
   $mw->bind($class,'<Meta-d>',['delete','insert','insert wordend']);
   $mw->bind($class,'<Meta-BackSpace>',['delete','insert-1c wordstart','insert']);

   # A few additional bindings of my own.
   $mw->bind($class,'<Control-h>','deleteBefore');
   $mw->bind($class,'<ButtonRelease-2>','ButtonRelease2');
  }
#JD# $Tk::prevPos = undef;
 return $class;
}

sub insertTab
{
 my ($w) = @_;
 $w->Insert("\t");
 $w->focus;
 $w->break
}

sub deleteToEndofLine
{
 my ($w) = @_;
 if ($w->compare('insert','==','insert lineend'))
  {
   $w->delete('insert')
  }
 else
  {
   $w->delete('insert','insert lineend')
  }
}

sub openLine
{
 my ($w) = @_;
 $w->insert('insert',"\n");
 $w->markSet('insert','insert-1c')
}

sub Button2
{
 my ($w,$x,$y) = @_;
 $w->scan('mark',$x,$y);
 $Tk::x = $x;
 $Tk::y = $y;
 $Tk::mouseMoved = 0;
}

sub Motion2
{
 my ($w,$x,$y) = @_;

Text/Text.pm  view on Meta::CPAN

  my ($first_line, $first_col) = split(/\./,$first);
  my ($last_line, $last_col) = split(/\./,$last);
  unless($first_line == $last_line)
   {$last = $first. ' lineend';}

  $find_entry->insert('insert', $w->get($first , $last));
  }
 else
  {
  my $selected;
  eval {$selected=$w->SelectionGet(-selection => "PRIMARY"); };
  if($@) {}
  elsif (defined($selected))
   {$find_entry->insert('insert', $selected);}
  }

 $find_entry->icursor(0);

 my ($replace_entry,$button_replace,$button_replace_all);
 unless ($find_only)
  {
   $replace_entry = $pop->Entry(-width=>25);

  $replace_entry -> pack(-anchor=>'nw', '-expand' => 'yes' , -fill => 'x');
  }


 my $button_find = $pop->Button(-text=>'Find', -command => $donext, -default => 'active')
  -> pack(-side => 'left');

 my $button_find_all = $pop->Button(-text=>'Find All',
  -command => sub {$w->FindAll($mode,$case,$find_entry->get());} )
  ->pack(-side => 'left');

 unless ($find_only)
  {
   $button_replace = $pop->Button(-text=>'Replace', -default => 'normal',
   -command => sub {$w->ReplaceSelectionsWith($replace_entry->get());} )
   -> pack(-side =>'left');
   $button_replace_all = $pop->Button(-text=>'Replace All',
   -command => sub {$w->FindAndReplaceAll
    ($mode,$case,$find_entry->get(),$replace_entry->get());} )
   ->pack(-side => 'left');
  }


  my $button_cancel = $pop->Button(-text=>'Cancel',
  -command => sub {$pop->destroy()} )
  ->pack(-side => 'left');

  $find_entry->bind("<Return>" => [$button_find, 'invoke']);
  $find_entry->bind("<Escape>" => [$button_cancel, 'invoke']);

 $find_entry->bind("<Return>" => [$button_find, 'invoke']);
 $find_entry->bind("<Escape>" => [$button_cancel, 'invoke']);

 $pop->resizable('yes','no');
 return $pop;
}

# paste clipboard into current location
sub clipboardPaste
{
 my ($w) = @_;
 local $@;
 Tk::catch { $w->Insert($w->clipboardGet) };
}

########################################################################
# Insert --
# Insert a string into a text at the point of the insertion cursor.
# If there is a selection in the text, and it covers the point of the
# insertion cursor, then delete the selection before inserting.
#
# Arguments:
# w - The text window in which to insert the string
# string - The string to insert (usually just a single character)
sub Insert
{
 my ($w,$string) = @_;
 return unless (defined $string && $string ne '');
 #figure out if cursor is inside a selection
 my @ranges = $w->tagRanges('sel');
 if (@ranges)
  {
   while (@ranges)
    {
     my ($first,$last) = splice(@ranges,0,2);
     if ($w->compare($first,'<=','insert') && $w->compare($last,'>=','insert'))
      {
       $w->ReplaceSelectionsWith($string);
       return;
      }
    }
  }
 # paste it at the current cursor location
 $w->insert('insert',$string);
 $w->see('insert');
}

# UpDownLine --
# Returns the index of the character one *display* line above or below the
# insertion cursor. There are two tricky things here. First,
# we want to maintain the original column across repeated operations,
# even though some lines that will get passed through do not have
# enough characters to cover the original column. Second, do not
# try to scroll past the beginning or end of the text.
#
# This may have some weirdness associated with a proportional font. Ie.
# the insertion cursor will zigzag up or down according to the width of
# the character at destination.
#
# Arguments:
# w - The text window in which the cursor is to move.
# n - The number of lines to move: -1 for up one line,
# +1 for down one line.
sub UpDownLine
{
 my ($w,$n) = @_;
 $w->see('insert');
 my $i = $w->index('insert');

 my ($line,$char) = split(/\./,$i);

 my $testX; #used to check the "new" position
 my $testY; #used to check the "new" position

Text/Text.pm  view on Meta::CPAN

 # a fraction of the entire contents of the Text widget
 my $yview = ($w->yview)[1];

 # If $yview is 1.0 this means that 'end' is visible in the window
 my $update = 0;
 $update = 1 if $yview == 1.0;

 # Loop over all input strings
 while (@_)
  {
   $w->insert('end',shift);
  }
  # Move the window to see the end of the text if required
  $w->see('end') if $update;
}

sub PRINTF
{
 my $w = shift;
 $w->PRINT(sprintf(shift,@_));
}

sub WRITE
{
 my ($w, $scalar, $length, $offset) = @_;
 unless (defined $length) { $length = length $scalar }
 unless (defined $offset) { $offset = 0 }
 $w->PRINT(substr($scalar, $offset, $length));
}

sub WhatLineNumberPopUp
{
 my ($w)=@_;
 my ($line,$col) = split(/\./,$w->index('insert'));
 $w->messageBox(-type => 'Ok', -title => "What Line Number",
                -message => "The cursor is on line $line (column is $col)");
}

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'],
    ]],
  ];
}

########################################################################
sub clipboardColumnCopy
{
 my ($w) = @_;
 $w->Column_Copy_or_Cut(0);
}

sub clipboardColumnCut
{
 my ($w) = @_;
 $w->Column_Copy_or_Cut(1);
}

########################################################################
sub Column_Copy_or_Cut
{
 my ($w, $cut) = @_;
 my @ranges = $w->tagRanges('sel');
 my $range_total = @ranges;
 # this only makes sense if there is one selected block
 unless ($range_total==2)
  {
  $w->bell;
  return;
  }

 my $selection_start_index = shift(@ranges);
 my $selection_end_index = shift(@ranges);

 my ($start_line, $start_column) = split(/\./, $selection_start_index);
 my ($end_line,   $end_column)   = split(/\./, $selection_end_index);

 # correct indices for tabs
 my $string;
 $string = $w->get($start_line.'.0', $start_line.'.0 lineend');
 $string = substr($string, 0, $start_column);
 $string = expand($string);
 my $tab_start_column = length($string);

 $string = $w->get($end_line.'.0', $end_line.'.0 lineend');
 $string = substr($string, 0, $end_column);
 $string = expand($string);
 my $tab_end_column = length($string);

 my $length = $tab_end_column - $tab_start_column;

 $selection_start_index = $start_line . '.' . $tab_start_column;
 $selection_end_index   = $end_line   . '.' . $tab_end_column;

 # clear the clipboard
 $w->clipboardClear;
 my ($clipstring, $startstring, $endstring);
 my $padded_string = ' 'x$tab_end_column;
 for(my $line = $start_line; $line <= $end_line; $line++)
  {
  $string = $w->get($line.'.0', $line.'.0 lineend');
  $string = expand($string) . $padded_string;
  $clipstring = substr($string, $tab_start_column, $length);
  #$clipstring = unexpand($clipstring);
  $w->clipboardAppend($clipstring."\n");

  if ($cut)
   {
   $startstring = substr($string, 0, $tab_start_column);
   $startstring = unexpand($startstring);
   $start_column = length($startstring);

   $endstring = substr($string, 0, $tab_end_column );
   $endstring = unexpand($endstring);
   $end_column = length($endstring);

   $w->delete($line.'.'.$start_column,  $line.'.'.$end_column);
   }
  }
}

########################################################################

sub clipboardColumnPaste
{
 my ($w) = @_;
 my @ranges = $w->tagRanges('sel');
 my $range_total = @ranges;
 if ($range_total)
  {
  warn " there cannot be any selections during clipboardColumnPaste. \n";
  $w->bell;
  return;
  }

 my $clipboard_text;
 eval
  {
  $clipboard_text = $w->SelectionGet(-selection => "CLIPBOARD");
  };

 return unless (defined($clipboard_text));
 return unless (length($clipboard_text));
 my $string;

 my $current_index = $w->index('insert');
 my ($current_line, $current_column) = split(/\./,$current_index);
 $string = $w->get($current_line.'.0', $current_line.'.'.$current_column);
 $string = expand($string);
 $current_column = length($string);

 my @clipboard_lines = split(/\n/,$clipboard_text);
 my $length;
 my $end_index;
 my ($delete_start_column, $delete_end_column, $insert_column_index);
 foreach my $line (@clipboard_lines)
  {
  if ($w->OverstrikeMode)
   {
   #figure out start and end indexes to delete, compensating for tabs.
   $string = $w->get($current_line.'.0', $current_line.'.0 lineend');
   $string = expand($string);
   $string = substr($string, 0, $current_column);
   $string = unexpand($string);
   $delete_start_column = length($string);

   $string = $w->get($current_line.'.0', $current_line.'.0 lineend');
   $string = expand($string);
   $string = substr($string, 0, $current_column + length($line));
   chomp($string);  # don't delete a "\n" on end of line.
   $string = unexpand($string);
   $delete_end_column = length($string);



   $w->delete(
              $current_line.'.'.$delete_start_column ,
              $current_line.'.'.$delete_end_column
             );
   }

  $string = $w->get($current_line.'.0', $current_line.'.0 lineend');
  $string = expand($string);
  $string = substr($string, 0, $current_column);
  $string = unexpand($string);
  $insert_column_index = length($string);

  $w->insert($current_line.'.'.$insert_column_index, unexpand($line));
  $current_line++;
  }

}

# Backward compatibility
sub GetMenu
{
 carp((caller(0))[3]." is deprecated") if $^W;
 shift->menu
}

1;
__END__