diff options
author | Staszek Wawrykiewicz <staw@gust.org.pl> | 2006-12-18 03:20:19 +0000 |
---|---|---|
committer | Staszek Wawrykiewicz <staw@gust.org.pl> | 2006-12-18 03:20:19 +0000 |
commit | 34c11d2616bb32772199abf210ae88d99665a824 (patch) | |
tree | b95fbfb76fcefd0ab1ca96dc631e2657a894ad6d /Master/xemtex/perl/site/lib/Tk/Text.pm | |
parent | b0ccdf9e931213c59344f3c097608e04721149b1 (diff) |
xemtex deleted
git-svn-id: svn://tug.org/texlive/trunk@2777 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/xemtex/perl/site/lib/Tk/Text.pm')
-rw-r--r-- | Master/xemtex/perl/site/lib/Tk/Text.pm | 1600 |
1 files changed, 0 insertions, 1600 deletions
diff --git a/Master/xemtex/perl/site/lib/Tk/Text.pm b/Master/xemtex/perl/site/lib/Tk/Text.pm deleted file mode 100644 index c4b4f162f77..00000000000 --- a/Master/xemtex/perl/site/lib/Tk/Text.pm +++ /dev/null @@ -1,1600 +0,0 @@ -# text.tcl -- -# -# This file defines the default bindings for Tk text widgets. -# -# @(#) text.tcl 1.18 94/12/17 16:05:26 -# -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# perl/Tk version: -# Copyright (c) 1995-1999 Nick Ing-Simmons -# Copyright (c) 1999 Greg London -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package Tk::Text; -use AutoLoader; -use Carp; -use strict; - -use Text::Tabs; - -use vars qw($VERSION); -$VERSION = '3.044'; # $Id: //depot/Tk8/Text/Text.pm#44 $ - -use Tk qw(Ev $XS_VERSION); -use base qw(Tk::Clipboard Tk::Widget); - -Construct Tk::Widget 'Text'; - -bootstrap Tk::Text; - -sub Tk_cmd { \&Tk::text } - -sub Tk::Widget::ScrlText { shift->Scrolled('Text' => @_) } - -Tk::Methods('bbox','compare','debug','delete','dlineinfo','dump', - 'get','image','index','insert','mark','scan','search', - 'see','tag','window','xview','yview'); - -use Tk::Submethods ( 'mark' => [qw(gravity names next previous set unset)], - 'scan' => [qw(mark dragto)], - 'tag' => [qw(add bind cget configure delete lower - names nextrange prevrange raise ranges remove)], - 'window' => [qw(cget configure create names)], - 'image' => [qw(cget configure create names)], - 'xview' => [qw(moveto scroll)], - 'yview' => [qw(moveto scroll)], - ); - -sub Tag; -sub Tags; - -sub bindRdOnly -{ - - my ($class,$mw) = @_; - - # Standard Motif bindings: - $mw->bind($class,'<Meta-B1-Motion>','NoOp'); - $mw->bind($class,'<Meta-1>','NoOp'); - $mw->bind($class,'<Alt-KeyPress>','NoOp'); - $mw->bind($class,'<Escape>','unselectAll'); - - $mw->bind($class,'<1>',['Button1',Ev('x'),Ev('y')]); - $mw->bind($class,'<B1-Motion>','B1_Motion' ) ; - $mw->bind($class,'<B1-Leave>','B1_Leave' ) ; - $mw->bind($class,'<B1-Enter>','CancelRepeat'); - $mw->bind($class,'<ButtonRelease-1>','CancelRepeat'); - $mw->bind($class,'<Control-1>',['markSet','insert',Ev('@')]); - - $mw->bind($class,'<Double-1>','selectWord' ) ; - $mw->bind($class,'<Triple-1>','selectLine' ) ; - $mw->bind($class,'<Shift-1>','adjustSelect' ) ; - $mw->bind($class,'<Double-Shift-1>',['SelectTo',Ev('@'),'word']); - $mw->bind($class,'<Triple-Shift-1>',['SelectTo',Ev('@'),'line']); - - $mw->bind($class,'<Left>',['SetCursor',Ev('index','insert-1c')]); - $mw->bind($class,'<Shift-Left>',['KeySelect',Ev('index','insert-1c')]); - $mw->bind($class,'<Control-Left>',['SetCursor',Ev('index','insert-1c wordstart')]); - $mw->bind($class,'<Shift-Control-Left>',['KeySelect',Ev('index','insert-1c wordstart')]); - - $mw->bind($class,'<Right>',['SetCursor',Ev('index','insert+1c')]); - $mw->bind($class,'<Shift-Right>',['KeySelect',Ev('index','insert+1c')]); - $mw->bind($class,'<Control-Right>',['SetCursor',Ev('index','insert+1c wordend')]); - $mw->bind($class,'<Shift-Control-Right>',['KeySelect',Ev('index','insert wordend')]); - - $mw->bind($class,'<Up>',['SetCursor',Ev('UpDownLine',-1)]); - $mw->bind($class,'<Shift-Up>',['KeySelect',Ev('UpDownLine',-1)]); - $mw->bind($class,'<Control-Up>',['SetCursor',Ev('PrevPara','insert')]); - $mw->bind($class,'<Shift-Control-Up>',['KeySelect',Ev('PrevPara','insert')]); - - $mw->bind($class,'<Down>',['SetCursor',Ev('UpDownLine',1)]); - $mw->bind($class,'<Shift-Down>',['KeySelect',Ev('UpDownLine',1)]); - $mw->bind($class,'<Control-Down>',['SetCursor',Ev('NextPara','insert')]); - $mw->bind($class,'<Shift-Control-Down>',['KeySelect',Ev('NextPara','insert')]); - - $mw->bind($class,'<Home>',['SetCursor','insert linestart']); - $mw->bind($class,'<Shift-Home>',['KeySelect','insert linestart']); - $mw->bind($class,'<Control-Home>',['SetCursor','1.0']); - $mw->bind($class,'<Control-Shift-Home>',['KeySelect','1.0']); - - $mw->bind($class,'<End>',['SetCursor','insert lineend']); - $mw->bind($class,'<Shift-End>',['KeySelect','insert lineend']); - $mw->bind($class,'<Control-End>',['SetCursor','end-1char']); - $mw->bind($class,'<Control-Shift-End>',['KeySelect','end-1char']); - - $mw->bind($class,'<Prior>',['SetCursor',Ev('ScrollPages',-1)]); - $mw->bind($class,'<Shift-Prior>',['KeySelect',Ev('ScrollPages',-1)]); - $mw->bind($class,'<Control-Prior>',['xview','scroll',-1,'page']); - - $mw->bind($class,'<Next>',['SetCursor',Ev('ScrollPages',1)]); - $mw->bind($class,'<Shift-Next>',['KeySelect',Ev('ScrollPages',1)]); - $mw->bind($class,'<Control-Next>',['xview','scroll',1,'page']); - - $mw->bind($class,'<Shift-Tab>', 'NoOp'); # Needed only to keep <Tab> binding from triggering; does not have to actually do anything. - $mw->bind($class,'<Control-Tab>','focusNext'); - $mw->bind($class,'<Control-Shift-Tab>','focusPrev'); - - $mw->bind($class,'<Control-space>',['markSet','anchor','insert']); - $mw->bind($class,'<Select>',['markSet','anchor','insert']); - $mw->bind($class,'<Control-Shift-space>',['SelectTo','insert','char']); - $mw->bind($class,'<Shift-Select>',['SelectTo','insert','char']); - $mw->bind($class,'<Control-slash>','selectAll'); - $mw->bind($class,'<Control-backslash>','unselectAll'); - - if (!$Tk::strictMotif) - { - $mw->bind($class,'<Control-a>', ['SetCursor','insert linestart']); - $mw->bind($class,'<Control-b>', ['SetCursor','insert-1c']); - $mw->bind($class,'<Control-e>', ['SetCursor','insert lineend']); - $mw->bind($class,'<Control-f>', ['SetCursor','insert+1c']); - $mw->bind($class,'<Meta-b>', ['SetCursor','insert-1c wordstart']); - $mw->bind($class,'<Meta-f>', ['SetCursor','insert wordend']); - $mw->bind($class,'<Meta-less>', ['SetCursor','1.0']); - $mw->bind($class,'<Meta-greater>', ['SetCursor','end-1c']); - - $mw->bind($class,'<Control-n>', ['SetCursor',Ev('UpDownLine',1)]); - $mw->bind($class,'<Control-p>', ['SetCursor',Ev('UpDownLine',-1)]); - - $mw->bind($class,'<2>',['Button2',Ev('x'),Ev('y')]); - $mw->bind($class,'<B2-Motion>',['Motion2',Ev('x'),Ev('y')]); - } - $mw->bind($class,'<Destroy>','Destroy'); - $mw->bind($class, '<3>', ['PostPopupMenu', Ev('X'), Ev('Y')] ); - - 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'); - } - $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) = @_; - $Tk::mouseMoved = 1 if ($x != $Tk::x || $y != $Tk::y); - $w->scan('dragto',$x,$y) if ($Tk::mouseMoved); -} - -sub ButtonRelease2 -{ - my ($w) = @_; - my $Ev = $w->XEvent; - if (!$Tk::mouseMoved) - { - Tk::catch { $w->insert($Ev->xy,$w->SelectionGet) } - } -} - -sub InsertSelection -{ - my ($w) = @_; - Tk::catch { $w->Insert($w->SelectionGet) } -} - -sub Backspace -{ - my ($w) = @_; - my $sel = Tk::catch { $w->tag('nextrange','sel','1.0','end') }; - if (defined $sel) - { - $w->delete('sel.first','sel.last'); - return; - } - $w->deleteBefore; -} - -sub deleteBefore -{ - my ($w) = @_; - if ($w->compare('insert','!=','1.0')) - { - $w->delete('insert-1c'); - $w->see('insert') - } -} - -sub Delete -{ - my ($w) = @_; - my $sel = Tk::catch { $w->tag('nextrange','sel','1.0','end') }; - if (defined $sel) - { - $w->delete('sel.first','sel.last') - } - else - { - $w->delete('insert'); - $w->see('insert') - } -} - -# Button1 -- -# This procedure is invoked to handle button-1 presses in text -# widgets. It moves the insertion cursor, sets the selection anchor, -# and claims the input focus. -# -# Arguments: -# w - The text window in which the button was pressed. -# x - The x-coordinate of the button press. -# y - The x-coordinate of the button press. -sub Button1 -{ - my ($w,$x,$y) = @_; - $Tk::selectMode = 'char'; - $Tk::mouseMoved = 0; - $w->SetCursor('@'.$x.','.$y); - $w->markSet('anchor','insert'); - $w->focus() if ($w->cget('-state') eq 'normal'); -} - -sub B1_Motion -{ - my ($w) = @_; - return unless defined $Tk::mouseMoved; - my $Ev = $w->XEvent; - $Tk::x = $Ev->x; - $Tk::y = $Ev->y; - $w->SelectTo($Ev->xy) -} - -sub B1_Leave -{ - my ($w) = @_; - my $Ev = $w->XEvent; - $Tk::x = $Ev->x; - $Tk::y = $Ev->y; - $w->AutoScan; -} - -# SelectTo -- -# This procedure is invoked to extend the selection, typically when -# dragging it with the mouse. Depending on the selection mode (character, -# word, line) it selects in different-sized units. This procedure -# ignores mouse motions initially until the mouse has moved from -# one character to another or until there have been multiple clicks. -# -# Arguments: -# w - The text window in which the button was pressed. -# index - Index of character at which the mouse button was pressed. -sub SelectTo -{ - my ($w, $index, $mode)= @_; - $Tk::selectMode = $mode if defined ($mode); - my $cur = $w->index($index); - my $anchor = Tk::catch { $w->index('anchor') }; - if (!defined $anchor) - { - $w->markSet('anchor',$anchor = $cur); - $Tk::mouseMoved = 0; - } - elsif ($w->compare($cur,'!=',$anchor)) - { - $Tk::mouseMoved = 1; - } - $Tk::selectMode = 'char' unless (defined $Tk::selectMode); - $mode = $Tk::selectMode; - my ($first,$last); - if ($mode eq 'char') - { - if ($w->compare($cur,'<','anchor')) - { - $first = $cur; - $last = 'anchor'; - } - else - { - $first = 'anchor'; - $last = $cur - } - } - elsif ($mode eq 'word') - { - if ($w->compare($cur,'<','anchor')) - { - $first = $w->index("$cur wordstart"); - $last = $w->index('anchor - 1c wordend') - } - else - { - $first = $w->index('anchor wordstart'); - $last = $w->index("$cur wordend") - } - } - elsif ($mode eq 'line') - { - if ($w->compare($cur,'<','anchor')) - { - $first = $w->index("$cur linestart"); - $last = $w->index('anchor - 1c lineend + 1c') - } - else - { - $first = $w->index('anchor linestart'); - $last = $w->index("$cur lineend + 1c") - } - } - if ($Tk::mouseMoved || $Tk::selectMode ne 'char') - { - $w->tagRemove('sel','1.0',$first); - $w->tagAdd('sel',$first,$last); - $w->tagRemove('sel',$last,'end'); - $w->idletasks; - } -} -# AutoScan -- -# This procedure is invoked when the mouse leaves a text window -# with button 1 down. It scrolls the window up, down, left, or right, -# depending on where the mouse is (this information was saved in -# tkPriv(x) and tkPriv(y)), and reschedules itself as an 'after' -# command so that the window continues to scroll until the mouse -# moves back into the window or the mouse button is released. -# -# Arguments: -# w - The text window. -sub AutoScan -{ - my ($w) = @_; - if ($Tk::y >= $w->height) - { - $w->yview('scroll',2,'units') - } - elsif ($Tk::y < 0) - { - $w->yview('scroll',-2,'units') - } - elsif ($Tk::x >= $w->width) - { - $w->xview('scroll',2,'units') - } - elsif ($Tk::x < 0) - { - $w->xview('scroll',-2,'units') - } - else - { - return; - } - $w->SelectTo('@' . $Tk::x . ','. $Tk::y); - $w->RepeatId($w->after(50,['AutoScan',$w])); -} -# SetCursor -# Move the insertion cursor to a given position in a text. Also -# clears the selection, if there is one in the text, and makes sure -# that the insertion cursor is visible. -# -# Arguments: -# w - The text window. -# pos - The desired new position for the cursor in the window. -sub SetCursor -{ - my ($w,$pos) = @_; - $pos = 'end - 1 chars' if $w->compare($pos,'==','end'); - $w->markSet('insert',$pos); - $w->unselectAll; - $w->see('insert') -} -# KeySelect -# This procedure is invoked when stroking out selections using the -# keyboard. It moves the cursor to a new position, then extends -# the selection to that position. -# -# Arguments: -# w - The text window. -# new - A new position for the insertion cursor (the cursor has not -# actually been moved to this position yet). -sub KeySelect -{ - my ($w,$new) = @_; - my ($first,$last); - if (!defined $w->tag('ranges','sel')) - { - # No selection yet - $w->markSet('anchor','insert'); - if ($w->compare($new,'<','insert')) - { - $w->tagAdd('sel',$new,'insert') - } - else - { - $w->tagAdd('sel','insert',$new) - } - } - else - { - # Selection exists - if ($w->compare($new,'<','anchor')) - { - $first = $new; - $last = 'anchor' - } - else - { - $first = 'anchor'; - $last = $new - } - $w->tagRemove('sel','1.0',$first); - $w->tagAdd('sel',$first,$last); - $w->tagRemove('sel',$last,'end') - } - $w->markSet('insert',$new); - $w->see('insert'); - $w->idletasks; -} -# ResetAnchor -- -# Set the selection anchor to whichever end is farthest from the -# index argument. One special trick: if the selection has two or -# fewer characters, just leave the anchor where it is. In this -# case it does not matter which point gets chosen for the anchor, -# and for the things like Shift-Left and Shift-Right this produces -# better behavior when the cursor moves back and forth across the -# anchor. -# -# Arguments: -# w - The text widget. -# index - Position at which mouse button was pressed, which determines -# which end of selection should be used as anchor point. -sub ResetAnchor -{ - my ($w,$index) = @_; - if (!defined $w->tag('ranges','sel')) - { - $w->markSet('anchor',$index); - return; - } - my $a = $w->index($index); - my $b = $w->index('sel.first'); - my $c = $w->index('sel.last'); - if ($w->compare($a,'<',$b)) - { - $w->markSet('anchor','sel.last'); - return; - } - if ($w->compare($a,'>',$c)) - { - $w->markSet('anchor','sel.first'); - return; - } - my ($lineA,$chA) = split(/\./,$a); - my ($lineB,$chB) = split(/\./,$b); - my ($lineC,$chC) = split(/\./,$c); - if ($lineB < $lineC+2) - { - my $total = length($w->get($b,$c)); - if ($total <= 2) - { - return; - } - if (length($w->get($b,$a)) < $total/2) - { - $w->markSet('anchor','sel.last') - } - else - { - $w->markSet('anchor','sel.first') - } - return; - } - if ($lineA-$lineB < $lineC-$lineA) - { - $w->markSet('anchor','sel.last') - } - else - { - $w->markSet('anchor','sel.first') - } -} - -######################################################################## -sub markExists -{ - my ($w, $markname)=@_; - my $mark_exists=0; - my @markNames_list = $w->markNames; - foreach my $mark (@markNames_list) - { if ($markname eq $mark) {$mark_exists=1;last;} } - return $mark_exists; -} - -######################################################################## -sub OverstrikeMode -{ - my ($w,$mode) = @_; - - $w->{'OVERSTRIKE_MODE'} =0 unless exists($w->{'OVERSTRIKE_MODE'}); - - $w->{'OVERSTRIKE_MODE'}=$mode if (@_ > 1); - - return $w->{'OVERSTRIKE_MODE'}; -} - -######################################################################## -# pressed the <Insert> key, just above 'Del' key. -# this toggles between insert mode and overstrike mode. -sub ToggleInsertMode -{ - my ($w)=@_; - $w->OverstrikeMode(!$w->OverstrikeMode); -} - -######################################################################## -sub InsertKeypress -{ - my ($w,$char)=@_; - if ($w->OverstrikeMode) - { - my $current=$w->get('insert'); - $w->delete('insert') unless($current eq "\n"); - } - $w->Insert($char); -} - -######################################################################## -sub GotoLineNumber -{ - my ($w,$line_number) = @_; - $line_number=~ s/^\s+|\s+$//g; - return if $line_number =~ m/\D/; - my ($last_line,$junk) = split(/\./, $w->index('end')); - if ($line_number > $last_line) {$line_number = $last_line; } - $w->{'LAST_GOTO_LINE'} = $line_number; - $w->markSet('insert', $line_number.'.0'); - $w->see('insert'); -} - -######################################################################## -sub GotoLineNumberPopUp -{ - my ($w)=@_; - my $popup = $w->{'GOTO_LINE_NUMBER_POPUP'}; - - unless (defined($w->{'LAST_GOTO_LINE'})) - { - my ($line,$col) = split(/\./, $w->index('insert')); - $w->{'LAST_GOTO_LINE'} = $line; - } - - ## if anything is selected when bring up the pop-up, put it in entry window. - my $selected; - eval { $selected = $w->SelectionGet(-selection => "PRIMARY"); }; - unless ($@) - { - if (defined($selected) and length($selected)) - { - unless ($selected =~ /\D/) - { - $w->{'LAST_GOTO_LINE'} = $selected; - } - } - } - unless (defined($popup)) - { - require Tk::DialogBox; - $popup = $w->DialogBox(-buttons => [qw[Ok Cancel]],-title => "Goto Line Number", -popover => $w, - -command => sub { $w->GotoLineNumber($w->{'LAST_GOTO_LINE'}) if $_[0] eq 'Ok'}); - $w->{'GOTO_LINE_NUMBER_POPUP'}=$popup; - $popup->resizable('no','no'); - my $frame = $popup->Frame->pack(-fill => 'x'); - $frame->Label(text=>'Enter line number: ')->pack(-side => 'left'); - my $entry = $frame->Entry(-background=>'white',width=>25, - -textvariable => \$w->{'LAST_GOTO_LINE'})->pack(-side =>'left',-fill => 'x'); - $popup->Advertise(entry => $entry); - } - $popup->Popup; - $popup->Subwidget('entry')->focus; - $popup->Wait; -} - -######################################################################## - -sub getSelected -{ - shift->GetTextTaggedWith('sel'); -} - -sub deleteSelected -{ - shift->DeleteTextTaggedWith('sel'); -} - -sub GetTextTaggedWith -{ - my ($w,$tag) = @_; - - my @ranges = $w->tagRanges($tag); - my $range_total = @ranges; - my $return_text=''; - - # if nothing selected, then ignore - if ($range_total == 0) {return $return_text;} - - # for every range-pair, get selected text - while(@ranges) - { - my $first = shift(@ranges); - my $last = shift(@ranges); - my $text = $w->get($first , $last); - if(defined($text)) - {$return_text = $return_text . $text;} - # if there is more tagged text, separate with an end of line character - if(@ranges) - {$return_text = $return_text . "\n";} - } - return $return_text; -} - -######################################################################## -sub DeleteTextTaggedWith -{ - my ($w,$tag) = @_; - my @ranges = $w->tagRanges($tag); - my $range_total = @ranges; - - # if nothing tagged with that tag, then ignore - if ($range_total == 0) {return;} - - # insert marks where selections are located - # marks will move with text even as text is inserted and deleted - # in a previous selection. - for (my $i=0; $i<$range_total; $i++) - { $w->markSet('mark_tag_'.$i => $ranges[$i]); } - - # for every selected mark pair, insert new text and delete old text - for (my $i=0; $i<$range_total; $i=$i+2) - { - my $first = $w->index('mark_tag_'.$i); - my $last = $w->index('mark_tag_'.($i+1)); - - my $text = $w->delete($first , $last); - } - - # delete the marks - for (my $i=0; $i<$range_total; $i++) - { $w->markUnset('mark_tag_'.$i); } -} - - -######################################################################## -sub FindAll -{ - my ($w,$mode, $case, $pattern ) = @_; - ### 'sel' tags accumulate, need to remove any previous existing - $w->unselectAll; - - my $match_length=0; - my $start_index; - my $end_index = '1.0'; - - while(defined($end_index)) - { - if ($case eq '-nocase') - { - $start_index = $w->search( - $mode, - $case, - -count => \$match_length, - "--", - $pattern , - $end_index, - 'end'); - } - else - { - $start_index = $w->search( - $mode, - -count => \$match_length, - "--", - $pattern , - $end_index, - 'end'); - } - - unless(defined($start_index) && $start_index) {last;} - - my ($line,$col) = split(/\./, $start_index); - $col = $col + $match_length; - $end_index = $line.'.'.$col; - $w->tagAdd('sel', $start_index, $end_index); - } -} - -######################################################################## -# get current selected text and search for the next occurrence -sub FindSelectionNext -{ - my ($w) = @_; - my $selected; - eval {$selected = $w->SelectionGet(-selection => "PRIMARY"); }; - return if($@); - return unless (defined($selected) and length($selected)); - - $w->FindNext('-forward', '-exact', '-case', $selected); -} - -######################################################################## -# get current selected text and search for the previous occurrence -sub FindSelectionPrevious -{ - my ($w) = @_; - my $selected; - eval {$selected = $w->SelectionGet(-selection => "PRIMARY"); }; - return if($@); - return unless (defined($selected) and length($selected)); - - $w->FindNext('-backward', '-exact', '-case', $selected); -} - - - -######################################################################## -sub FindNext -{ - my ($w,$direction, $mode, $case, $pattern ) = @_; - - ## if searching forward, start search at end of selected block - ## if backward, start search from start of selected block. - ## dont want search to find currently selected text. - ## tag 'sel' may not be defined, use eval loop to trap error - eval { - if ($direction eq '-forward') - { - $w->markSet('insert', 'sel.last'); - $w->markSet('current', 'sel.last'); - } - else - { - $w->markSet('insert', 'sel.first'); - $w->markSet('current', 'sel.first'); - } - }; - - my $saved_index=$w->index('insert'); - - # remove any previous existing tags - $w->unselectAll; - - my $match_length=0; - my $start_index; - - if ($case eq '-nocase') - { - $start_index = $w->search( - $direction, - $mode, - $case, - -count => \$match_length, - "--", - $pattern , - 'insert'); - } - else - { - $start_index = $w->search( - $direction, - $mode, - -count => \$match_length, - "--", - $pattern , - 'insert'); - } - - unless(defined($start_index)) { return 0; } - if(length($start_index) == 0) { return 0; } - - my ($line,$col) = split(/\./, $start_index); - $col = $col + $match_length; - my $end_index = $line.'.'.$col; - $w->tagAdd('sel', $start_index, $end_index); - - $w->see($start_index); - - if ($direction eq '-forward') - { - $w->markSet('insert', $end_index); - $w->markSet('current', $end_index); - } - else - { - $w->markSet('insert', $start_index); - $w->markSet('current', $start_index); - } - - my $compared_index = $w->index('insert'); - - my $ret_val; - if ($compared_index eq $saved_index) - {$ret_val=0;} - else - {$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); - } -} - -######################################################################## -sub ReplaceSelectionsWith -{ - my ($w,$new_text ) = @_; - - my @ranges = $w->tagRanges('sel'); - my $range_total = @ranges; - - # if nothing selected, then ignore - if ($range_total == 0) {return}; - - # insert marks where selections are located - # marks will move with text even as text is inserted and deleted - # in a previous selection. - for (my $i=0; $i<$range_total; $i++) - {$w->markSet('mark_sel_'.$i => $ranges[$i]); } - - # for every selected mark pair, insert new text and delete old text - my ($first, $last); - for (my $i=0; $i<$range_total; $i=$i+2) - { - $first = $w->index('mark_sel_'.$i); - $last = $w->index('mark_sel_'.($i+1)); - - ########################################################################## - # eventually, want to be able to get selected text, - # support regular expression matching, determine replace_text - # $replace_text = $selected_text=~m/$new_text/ (or whatever would work) - # will have to pass in mode and case flags. - # this would allow a regular expression search and replace to be performed - # example, look for "line (\d+):" and replace with "$1 >" or similar - ########################################################################## - - $w->insert($last, $new_text); - $w->delete($first, $last); - - } - ############################################################ - # set the insert cursor to the end of the last insertion mark - $w->markSet('insert',$w->index('mark_sel_'.($range_total-1))); - - # delete the marks - for (my $i=0; $i<$range_total; $i++) - { $w->markUnset('mark_sel_'.$i); } -} -######################################################################## -sub FindAndReplacePopUp -{ - my ($w)=@_; - $w->findandreplacepopup(0); -} - -######################################################################## -sub FindPopUp -{ - my ($w)=@_; - $w->findandreplacepopup(1); -} - -######################################################################## - -sub findandreplacepopup -{ - my ($w,$find_only)=@_; - - my $pop = $w->Toplevel; - if ($find_only) - { $pop->title("Find"); } - else - { $pop->title("Find and/or Replace"); } - my $frame = $pop->Frame->pack(-anchor=>'nw'); - - $frame->Label(text=>"Direction:") - ->grid(-row=> 1, -column=>1, -padx=> 20, -sticky => 'nw'); - my $direction = '-forward'; - $frame->Radiobutton( - variable => \$direction, - text => '-forward',value => '-forward' ) - ->grid(-row=> 2, -column=>1, -padx=> 20, -sticky => 'nw'); - $frame->Radiobutton( - variable => \$direction, - text => '-backward',value => '-backward' ) - ->grid(-row=> 3, -column=>1, -padx=> 20, -sticky => 'nw'); - - $frame->Label(text=>"Mode:") - ->grid(-row=> 1, -column=>2, -padx=> 20, -sticky => 'nw'); - my $mode = '-exact'; - $frame->Radiobutton( - variable => \$mode, text => '-exact',value => '-exact' ) - ->grid(-row=> 2, -column=>2, -padx=> 20, -sticky => 'nw'); - $frame->Radiobutton( - variable => \$mode, text => '-regexp',value => '-regexp' ) - ->grid(-row=> 3, -column=>2, -padx=> 20, -sticky => 'nw'); - - $frame->Label(text=>"Case:") - ->grid(-row=> 1, -column=>3, -padx=> 20, -sticky => 'nw'); - my $case = '-case'; - $frame->Radiobutton( - variable => \$case, text => '-case',value => '-case' ) - ->grid(-row=> 2, -column=>3, -padx=> 20, -sticky => 'nw'); - $frame->Radiobutton( - variable => \$case, text => '-nocase',value => '-nocase' ) - ->grid(-row=> 3, -column=>3, -padx=> 20, -sticky => 'nw'); - - ###################################################### - my $find_entry = $pop->Entry(width=>25); - - my $button_find = $pop->Button(text=>'Find', - command => sub {$w->FindNext ($direction,$mode,$case,$find_entry->get()),} ) - -> pack(-anchor=>'nw'); - - $find_entry -> pack(-anchor=>'nw', '-expand' => 'yes' , -fill => 'x'); # autosizing - - ###### if any $w text is selected, put it in the find entry - ###### could be more than one text block selected, get first selection - my @ranges = $w->tagRanges('sel'); - if (@ranges) - { - my $first = shift(@ranges); - my $last = shift(@ranges); - - # limit to one line - 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);} - } - - my ($replace_entry,$button_replace,$button_replace_all); - unless ($find_only) - { - ###################################################### - $replace_entry = $pop->Entry(width=>25); - ###################################################### - $button_replace = $pop->Button(text=>'Replace', - command => sub {$w->ReplaceSelectionsWith($replace_entry->get());} ) - -> pack(-anchor=>'nw'); - - $replace_entry -> pack(-anchor=>'nw', '-expand' => 'yes' , -fill => 'x'); - } - - ###################################################### - $pop->Label(text=>" ")->pack(); - ###################################################### - unless ($find_only) - { - $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_find_all = $pop->Button(text=>'Find All', - command => sub {$w->FindAll($mode,$case,$find_entry->get());} ) - ->pack(-side => 'left'); - - my $button_cancel = $pop->Button(text=>'Cancel', - command => sub {$pop->destroy()} ) - ->pack(-side => 'left'); - - $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 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. -# -# 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_old -{ - my ($w,$n) = @_; - my $i = $w->index('insert'); - my ($line,$char) = split(/\./,$i); - if (!defined($Tk::prevPos) || $Tk::prevPos ne $i) - { - $Tk::char = $char - } - my $new = $w->index($line+$n . '.' . $Tk::char); - if ($w->compare($new,'==','end') || $w->compare($new,'==','insert linestart')) - { - $new = $i - } - $Tk::prevPos = $new; - return $new; -} - -sub UpDownLine -{ - my ($w,$n) = @_; - my $i = $w->index('insert'); - my ($line,$char) = split(/\./,$i); - my $string = $w->get($line.'.0', $i); - - $string = expand($string); - $char=length($string); - $line += $n; - - $string = $w->get($line.'.0', $line.'.0 lineend'); - $string = expand($string); - $string = substr($string, 0, $char); - - $string = unexpand($string); - $char = length($string); - - my $new = $w->index($line . '.' . $char); - if ($w->compare($new,'==','end') || $w->compare($new,'==','insert linestart')) - { - $new = $i - } - $Tk::prevPos = $new; - $Tk::char = $char; - return $new; -} - - -# PrevPara -- -# Returns the index of the beginning of the paragraph just before a given -# position in the text (the beginning of a paragraph is the first non-blank -# character after a blank line). -# -# Arguments: -# w - The text window in which the cursor is to move. -# pos - Position at which to start search. -sub PrevPara -{ - my ($w,$pos) = @_; - $pos = $w->index("$pos linestart"); - while (1) - { - if ($w->get("$pos - 1 line") eq "\n" && $w->get($pos) ne "\n" || $pos eq '1.0' ) - { - my $string = $w->get($pos,"$pos lineend"); - if ($string =~ /^(\s)+/) - { - my $off = length($1); - $pos = $w->index("$pos + $off chars") - } - if ($w->compare($pos,'!=','insert') || $pos eq '1.0') - { - return $pos; - } - } - $pos = $w->index("$pos - 1 line") - } -} -# NextPara -- -# Returns the index of the beginning of the paragraph just after a given -# position in the text (the beginning of a paragraph is the first non-blank -# character after a blank line). -# -# Arguments: -# w - The text window in which the cursor is to move. -# start - Position at which to start search. -sub NextPara -{ - my ($w,$start) = @_; - my $pos = $w->index("$start linestart + 1 line"); - while ($w->get($pos) ne "\n") - { - if ($w->compare($pos,'==','end')) - { - return $w->index('end - 1c'); - } - $pos = $w->index("$pos + 1 line") - } - while ($w->get($pos) eq "\n" ) - { - $pos = $w->index("$pos + 1 line"); - if ($w->compare($pos,'==','end')) - { - return $w->index('end - 1c'); - } - } - my $string = $w->get($pos,"$pos lineend"); - if ($string =~ /^(\s+)/) - { - my $off = length($1); - return $w->index("$pos + $off chars"); - } - return $pos; -} -# ScrollPages -- -# This is a utility procedure used in bindings for moving up and down -# pages and possibly extending the selection along the way. It scrolls -# the view in the widget by the number of pages, and it returns the -# index of the character that is at the same position in the new view -# as the insertion cursor used to be in the old view. -# -# Arguments: -# w - The text window in which the cursor is to move. -# count - Number of pages forward to scroll; may be negative -# to scroll backwards. -sub ScrollPages -{ - my ($w,$count) = @_; - my @bbox = $w->bbox('insert'); - $w->yview('scroll',$count,'pages'); - if (!@bbox) - { - return $w->index('@' . int($w->height/2) . ',' . 0); - } - my $x = int($bbox[0]+$bbox[2]/2); - my $y = int($bbox[1]+$bbox[3]/2); - return $w->index('@' . $x . ',' . $y); -} - -sub Contents -{ - my $w = shift; - if (@_) - { - $w->delete('1.0','end'); - $w->insert('end',shift) while (@_); - } - else - { - return $w->get('1.0','end'); - } -} - -sub Destroy -{ - my ($w) = @_; - delete $w->{_Tags_}; -} - -sub Transpose -{ - my ($w) = @_; - my $pos = 'insert'; - $pos = $w->index("$pos + 1 char") if ($w->compare($pos,'!=',"$pos lineend")); - return if ($w->compare("$pos - 1 char",'==','1.0')); - my $new = $w->get("$pos - 1 char").$w->get("$pos - 2 char"); - $w->delete("$pos - 2 char",$pos); - $w->insert('insert',$new); - $w->see('insert'); -} - -sub Tag -{ - my $w = shift; - my $name = shift; - Carp::confess('No args') unless (ref $w and defined $name); - $w->{_Tags_} = {} unless (exists $w->{_Tags_}); - unless (exists $w->{_Tags_}{$name}) - { - require Tk::Text::Tag; - $w->{_Tags_}{$name} = 'Tk::Text::Tag'->new($w,$name); - } - $w->{_Tags_}{$name}->configure(@_) if (@_); - return $w->{_Tags_}{$name}; -} - -sub Tags -{ - my ($w,$name) = @_; - my @result = (); - foreach $name ($w->tagNames(@_)) - { - push(@result,$w->Tag($name)); - } - return @result; -} - -sub TIEHANDLE -{ - my ($class,$obj) = @_; - return $obj; -} - -sub PRINT -{ - my $w = shift; - # Find out whether 'end' is displayed at the moment - # Retrieve the position of the bottom of the window as - # 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 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); # dont 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__ - |