—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—

              
package Tk::CodeText;
HideShow 6 lines of Pod
=head1 NAME
Tk::CodeText - Programmer's Swiss army knife Text widget.
=cut
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.68';
use base qw(Tk::Derived Tk::Frame);
use Tk::CodeText::Kamelon;
use Tk;
use Tie::Watch;
require Tk::CodeText::StatusBar;
require Tk::CodeText::TagsEditor;
require Tk::CodeText::Theme;
require Tk::DialogBox;
require Tk::Font;
require Tk::XText;
require Tk::YAMessage;
Construct Tk::Widget 'CodeText';
my @defaultattributes = (
        'Alert' => [-background => '#DB7C47', -foreground => '#FFFFFF'],
        'Annotation' => [-foreground => '#5A5A5A'],
        'Attribute' => [-foreground => '#00B900', -weight => 'bold'],
        'BaseN' => [-foreground => '#0000A9'],
        'BuiltIn' => [-foreground => '#B500E6'],
        'Char' => [-foreground => '#FF00FF'],
        'Comment' => [foreground => '#5A5A5A', -slant => 'italic'],
        'CommentVar' => [-foreground => '#5A5A5A', -slant => 'italic', -weight => 'bold'],
        'Constant' => [-foreground => '#0000FF', -weight => 'bold'],
        'ControlFlow' => [-foreground => '#0062AD'],
        'DataType' => [-foreground => '#0080A8', -weight => 'bold'],
        'DecVal' => [-foreground => '#9C4E2B'],
        'Documentation' => [-foreground => '#7F5A41', -slant => 'italic'],
        'Error' => [-background => '#FF0000', -foreground => '#FFFF00'],
        'Extension' => [-foreground => '#9A53D1'],
        'Float' => [-foreground => '#9C4E2B', -weight => 'bold'],
        'Function' => [-foreground => '#008A00'],
        'Import' => [-foreground => '#950000', -slate => 'italic'],
        'Information' => [foreground => '#5A5A5A', -weight => 'bold'],
        'Keyword' => [-weight => 'bold'],
        'Normal' => [],
        'Operator' => [-foreground => '#85530E'],
        'Others' => [-foreground => '#FF6200'],
        'Preprocessor' => [-slant => 'italic'],
        'RegionMarker' => [-background => '#00CFFF'],
        'SpecialChar' => [-foreground => '#9A53D1'],
        'SpecialString' => [-foreground => '#FF4449'],
        'String' => [-foreground => '#FF0000'],
        'Variable' => [-foreground => '#0000FF', -weight => 'bold'],
        'VerbatimString' => [-foreground => '#FF4449', -weight => 'bold'],
        'Warning' => [-background => '#FFFF00', -foreground => '#FF0000'],
);
my $minusimg = '#define indicatorclose_width 11
#define indicatorclose_height 11
static unsigned char indicatorclose_bits[] = {
   0xff, 0x07, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0xfd, 0x05,
   0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0xff, 0x07 };
';
my $plusimg = '#define indicatoropen_width 11
#define indicatoropen_height 11
static unsigned char indicatoropen_bits[] = {
   0xff, 0x07, 0x01, 0x04, 0x21, 0x04, 0x21, 0x04, 0x21, 0x04, 0xfd, 0x05,
   0x21, 0x04, 0x21, 0x04, 0x21, 0x04, 0x01, 0x04, 0xff, 0x07 };
';
HideShow 304 lines of Pod
=head1 SYNOPSIS
 require Tk::CodeText;
 my $text= $window->CodeText(@options)->pack;
=head1 DESCRIPTION
B<Tk::CodeText> aims to be a Scintilla like text widget for Perl/Tk.
Version 0.40 of B<Tk::CodeText> was re-written from scratch. This version and all later
versions are not backwards compatible with version 0.3.4 and earlier.
It leans heavily on L<Syntax::Kamelon>. 
It features:
=over 4
=item line numbers on display
=item code folding
=item status bar 
The status bar has document info and tools for setting tab size, indent style and syntax
=item advanced word based undo/redo stack
It keeps track of the last saving point and selections
=item syntax highlighting in many languages and formats.
=item commenting and uncommenting blocks and lines
=item indenting and unindenting blocks and lines
=item automatic indentation
=item autocomplete
=item matching of nested {}, () and [] pairs
=back
=head1 OPTIONS
=over 4
=item Name: B<acPopSize>
=item Class: B<AcPopSize>
=item Switch: B<-acpopsize>
The length of the typed string to trigger autocomplete into making suggestions. Default value 5.
=item Name: B<acScanSize>
=item Class: B<AcScanSize>
=item Switch: B<-acscansize>
The minimal length of a word to be included in the autocomplete word database. Default value 5.
=item Name: B<activeDelay>
=item Class: B<ActiveDelay>
=item Switch: B<-activedelay>
The waiting time in miliseconds before an autocomplete pop up can occur. Default value 300.
=item Name: B<autoBrackets>
=item Class: B<AutoBrackets>
=item Switch: B<-autobrackets>
Boolean. Default value I<false>. Enables or disables autocomplete.
=item Name: B<autoComplete>
=item Class: B<AutoComplete>
=item Switch: B<-autocomplete>
Boolean. Default value I<false>. Enables or disables autocomplete.
=item Name: B<autoIndent>
=item Class: B<AutoIndent>
=item Switch: B<-autoindent>
By default 0. If set the text will be indented to the 
level and style of the previous line.
=item Name: B<bookmarkColor>
=item Class: B<BookmarkColor>
=item Switch: B<-bookmarkcolor>
Default value #71D0CC. Background color for the line number label
of a bookmarked line.
=item Name: B<bookmarkSize>
=item Class: B<BookmarkSize>
=item Switch: B<-bookmarksize>
Default value 20. length of the label for bookmark entries
in the bookmarks menu.
=item Name: B<configDir>
=item Class: B<ConfigDir>
=item Switch: B<-configdir>
An empty string by default. If set to an existing folder that folder will be used
for config files. Currently there is only one of those: The recent colors for the 
TagsEditor.
=item Switch: B<-contextmenu>
Reference to a Tk::Menu object that is used as context menu.
If you do not specify it, the B<-menuitems> option is checked.
=item Switch: B<-disablemenu>
By default 0. If set the right-click context menu is disabled.
=item Switch: B<-findoptions>
Default: [-background => '#C0FFC0', -foreground => '#000000'](light green and black). 
Specifies the options for the find tag.
=item Name: B<highlightInterval>
=item Class: B<HighlightInterval>
=item Switch: B<-highlightinterval>
By default 1 milisecond. Highlighting is done on a
line by line basis. This is the time between lines.
=item Name: B<indentStyle>
=item Class: B<IndentStyle>
=item Switch: B<-indentstyle>
Default value 'tab'. You can also set it to a number.
In that case an indent will be the number of spaces.
=item Name: B<linesPerCycle>
=item Class: B<LinesPerCycle>
=item Switch: B<-linespercycle>
Default value 10. It specifies how many lines Tk::CodeText will Highlight in one cycle.
You can tone it down if the application responds sluggish.
=item Switch: B<-match>
Default value '[]{}()'. Specifies which items to match
against nested occurrences.
=item Switch: B<-matchoptions>
Default: [-background => 'blue', -foreground => 'yellow'].
Specifies the options for the match tag.
=item Switch: B<-menuitems>
Specify the menu items for the left-click popup menu.
By default set to undef, meaning no popup menu.
=item Switch: B<-minusimg>
Image used for the collapse state of a folding point.
By default it is a bitmap defined in this module.
=item Switch: B<-mmodifiedcall>
Callback called whenever text is modified. It gets
the location index as parameter.
=item Switch: B<-plusimg>
Image used for the expand state of a folding point.
By default it is a bitmap defined in this module.
=item Switch: B<-readonly>
Default value 0. If you set it to 1 the user will not be
able to make modifications.
=item Switch: B<-saveimage>
The icon image used to indicate the text is modified on the status bar.
By default it is an internally defined xpm.
=item Switch: B<-scrollbars>
Default value 'osoe'. Specifies if and how scrollbars
are to be used. If you set it to an ampty string no
scrollbars will be created. See also L<Tk::Scrolled>.
Only available at create time.
=item Name: B<showSpaces>
=item Class: B<ShowSpaces>
=item Switch: B<-showspaces>
Default value 0. If set the leading and trailing spaces on each line
will be highlighted in their own back ground color. See also the 
B<-spacebackground> and B<-tabbackground> options.
=item Name: B<spaceBackground>
=item Class: B<SpaceBackground>
=item Switch: B<-spacebackground>
Default value #0098C2. The background color shown to leading and
trailing spaces when the B<-showspaces> option is set.
=item Switch: B<-statusinterval>
By default 200 ms. Update interval for the status bar.
=item Name: B<showFolds>
=item Class: B<ShowFolds>
=item Switch: B<-showfolds>
Default value 1. If cleared the folding markers
will be hidden.
=item Name: B<showNumbers>
=item Class: B<ShowNumbers>
=item Switch: B<-shownumbers>
Default value 1. If cleared the line numbers
will be hidden.
=item Name: B<showStatus>
=item Class: B<ShowStatus>
=item Switch: B<-showstatus>
Default value 1. If cleared the status bar
will be hidden.
=item Name: B<syntax>
=item Class: B<Syntax>
=item Switch: B<-syntax>
Default value 'None'. Sets and returns the currently
used syntax definition.
=item Name: B<tabBackground>
=item Class: B<TabBackground>
=item Switch: B<-tabbackground>
Default value #B5C200. The background color shown to leading and
trailing spaces when the B<-showspaces> option is set.
=item Switch: B<-themefile>
Default value undef. Sets and loads a theme file with tags information 
for highlighting. A call to cget returns the name of the loaded theme file.
See also L<Tk::CodeText::Theme>.
=item Switch: B<-xmlfolder>
XML folder to use for L<Syntax::Kamelon>
Only available at create time.
=back
=cut
=head1 METHODS
=over 4
=cut
sub Populate {
        my ($self,$args) = @_;
         
        my $scrollbars = delete $args->{'-scrollbars'};
        $scrollbars = 'soe' unless defined $scrollbars;
        my $theme = delete $args->{'-theme'};
        unless (defined $theme) {
                $theme = Tk::CodeText::Theme->new;
                $theme->put(@defaultattributes);
        }
        my @ko = (
                formatter => ['Base',
                        foldingdepth => 'all',
                ],
        );
        my $xmldir = delete $args->{'-xmlfolder'};
        push @ko, 'xmlfolder', $xmldir if defined $xmldir;
        $self->SUPER::Populate($args);
        $self->{COLORINF} = [];
        $self->{COLORED} = 1;
        $self->{FOLDBUTTONS} = {};
        $self->{FOLDINF} = [];
        $self->{FOLDSSHOWN} = [];
        $self->{FOLDSVISIBLE} = 0;
        $self->{KAMELON} = Tk::CodeText::Kamelon->new($self, @ko);
        $self->{HIGHLIGHTINTERVAL} = 1;
        $self->{LINESPERCYCLE} = 10;
        $self->{LOOPACTIVE} = 0;
        $self->{NOHIGHLIGHTING} = 1;
        $self->{NUMBERSVISIBLE} = 0;
        $self->{NUMBERINF} = [];
        $self->{POSTCONFIG} = 0;
        $self->{SHOWSPACES} = 0;
        $self->{SPACESCOMPLETED} = 1;
        $self->{SPACESLOOPACTIVE} = 0;
        $self->{STATUSVISIBLE} = 0;
        $self->{SYNTAX} = 'None';
        $self->{THEME} = $theme;
        $self->{SAVEFIRSTVISIBLE} = 1;
        $self->{SAVELASTVISIBLE} = 1;
         
        #create editor frame
        my $ef = $self->Frame(
                -relief => 'sunken',
                -borderwidth => 2,
        )->pack(
                -expand => 1,
                -fill => 'both',
        );
        #create the frame for the line numbers
        my $numbers = $ef->Frame(
                -width => 40,
        );
        #create the frame for code folding
        my $folds = $ef->Frame(
                -width => 18,
        );
        $folds->bind('<ButtonRelease-3>', [$self, 'foldsMenuPop', Ev('X'), Ev('Y')]);
        my $fmenu = $folds->Menu(
                -tearoff => 0,
                -menuitems => [
                        [command => 'Collapse All', -command => ['foldCollapseAll', $self]],
                        [command => 'Expand All', -command => ['foldExpandAll', $self]],
                ],
        );
        $fmenu->bind('<Leave>', [$fmenu, 'unpost']);
        #create the textwidget
        my @opt = (
                -escapepressed => ['FindClose', $self],
                -findandreplacecall => sub { $self->FindAndOrReplace(@_) },
                -modifycall => ['OnModify', $self],
                -relief => 'flat',
                -scrollbars => $scrollbars,
                -yscrollcmd => sub {
                        $self->foldsCheck;
                        $self->lnumberCheck;
                        $self->bookmarkCheck;
                },
        );
        my $text;
        if ($scrollbars eq '') {
                $text = $ef->XText(@opt)
        } else {
                $text = $ef->Scrolled('XText', @opt)
        }
        $text->pack(-side => 'left', -expand =>1, -fill => 'both');
         
        #create the find and replace panel
        my @pack = (-side => 'left', -padx => 2, -pady => 2);
        my $sandr = $self->Frame;
        $self->Advertise(SandR => $sandr);
        #searchframe
        my $case = '-case';
        my $find = '';
        my $reg = '-exact';
        my $replace = '';
         
        my $rframe; #the variable for the replaceframe must exist
        my $sframe = $sandr->Frame->pack(-fill => 'x');
        $sframe->Label(
                -anchor => 'e',
                -text => 'Find',
                -width => 7,
        )->pack(@pack);
        my $e = $sframe->Entry(
                -textvariable => \$find,
        )->pack(@pack, -expand => 1, -fill => 'x');
        $e->bind('<Escape>', [$self, 'FindClose']);
        $e->bind('<Return>', sub { $self->FindNext('-forward', $reg, $case, $find) });
        $sframe->Button(
                -text => 'Next',
                -command => sub { $self->FindNext('-forward', $reg, $case, $find) },
        )->pack(@pack); 
        $sframe->Button(
                -text => 'Previous',
                -command => sub { $self->FindNext('-backward', $reg, $case, $find) },
        )->pack(@pack);
        $sframe->Button(
                -text => 'All',
                -command => sub { $self->FindAll($reg, $case, $find) },
        )->pack(@pack);
        $sframe->Button(
                -text => 'Clear',
                -command => sub { $self->FindClear },
        )->pack(@pack);
        $sframe->Checkbutton(
                -text => 'Case',
                -onvalue => '-case',
                -offvalue => '-nocase',
                -variable => \$case,
        )->pack(@pack);
        $sframe->Checkbutton(
                -text => 'Reg',
                -onvalue => '-regexp',
                -offvalue => '-exact',
                -variable => \$reg,
        )->pack(@pack);
        $sframe->Button(
                -text => 'Close',
                -command => ['FindClose', $self],
        )->pack(@pack);
        #replaceframe
        $rframe = $sandr->Frame;
        $rframe->Label(
                -anchor => 'e',
                -text => 'Replace',
                -width => 7,
        )->pack(@pack);
        $self->Advertise(Replace => $rframe);
        my $r = $rframe->Entry(
                -textvariable => \$replace,
        )->pack(@pack, -expand => 1, -fill => 'x');
        $r->bind('<Escape>', [$self, 'FindClose']);
        $r->bind('<Return>',  sub {
                $self->ReplaceSelectionsWith($replace) if $self->SelectionExists;
                $self->FindNext('-forward', $reg, $case, $find);
        });
        $rframe->Button(
                -text => 'Replace',
                -command => sub { $self->FindandReplace($reg, $case, $find, $replace) },
        )->pack(@pack); 
        $rframe->Button(
                -text => 'Skip',
                -command => sub {    $self->FindNext('-forward', $reg, $case, $find)      },
        )->pack(@pack); 
        $rframe->Button(
                -text => 'Replace all',
                -command =>  sub { $self->FindandReplaceAll($reg, $case, $find, $replace) },
        )->pack(@pack);
        #create the statusbar
        my $statusbar = $self->StatusBar(
                -widget => $self,
        );
        $self->after(10, ['updateStatus', $statusbar]);
        #create progressbar for loading and saving
        $self->Advertise(XText => $text);
        $self->Advertise(Numbers => $numbers);
        $self->Advertise(Folds => $folds);
        $self->Advertise(Statusbar => $statusbar);
        $self->Advertise(Foldsmenu => $fmenu);
        $self->Advertise(FindEntry => $e);
        # hack for getting proper bitmap foreground
        my $l = $self->Label;
        my $fg = $l->cget('-foreground');
        $l->destroy;
        $text->tagConfigure('Hidden', -elide => 1);
        $text->tagConfigure('Space', -background => 'blue');
        $text->tagConfigure('Tab', -background => 'blue');
        $self->ConfigSpecs(
                -bookmarkcolor => [qw/PASSIVE bookmarkColor BookmarkColor/, '#71D0CC'],
                -bookmarksize => [qw/PASSIVE bookmarkSize BookmarkSize/, 20],
                -configdir => [qw/PASSIVE configdir ConfigDir/, ''],
                -font => [qw/METHOD font Font/, 'Monospace 10'],
                -highlightinterval => [qw/METHOD highlightInterval HighlightInterval/, 1],
                -linespercycle => [qw/METHOD linesPerCycle LinesPerCycle/, 10],
                -minusimg => ['PASSIVE', undef, undef, $self->Bitmap(
                        -data => $minusimg,
                        -foreground => $fg,
                )],
                -modifiedcall => ['CALLBACK', undef, undef, sub {}],
                -plusimg => ['PASSIVE', undef, undef, $self->Bitmap(
                        -data => $plusimg,
                        -foreground => $fg,
                )],
                -position => ['METHOD'],
                -saveimage => [$statusbar],
                -showfolds => [qw/METHOD showFolds ShowFolds/, 1],
                -shownumbers => [qw/METHOD showNumers ShowNumbers/, 1],
                -showspaces => [qw/METHOD showSpaces ShowSpaces/, 0],
                -showstatus => [qw/METHOD showStatus ShowStatus/, 1],
                -syntax => [qw/METHOD syntax Syntax/, 'None'],
                -statusinterval => [$statusbar],
                -spacebackground => [qw/METHOD spaceBackground SpaceBackground/, '#0098C2'],
                -tabbackground => [qw/METHOD tabBackground TabBackground/, '#B5C200'],
                -themefile => ['METHOD'],
                DEFAULT => [ $text ],
        );
        $self->Delegates(
                DEFAULT => $text,
        );
        $self->after(10, sub {
                $self->{POSTCONFIG} = 1;
                $self->themeUpdate;
                $self->lnumberCheck(1);
        });
}
HideShow 7 lines of Pod
=item B<bookmarkAdd>I<(?$line?)>
Bookmarks line number I<$line?>. If you do not specify I<$line?>, the line that has
the insert cursor is bookmarked.
=cut
sub bookmarkAdd {
        my ($self, $line) = @_;
        $line = $self->linenumber('insert') unless defined $line;
        return if $self->bookmarked($line);
        $self->tagAdd('BOOKMARK', "$line.0", "$line.0 lineend");
}
sub bookmarkCheck {
        my $self = shift;
        my $numframe = $self->Subwidget('Numbers');
        my $nbg = $numframe->cget('-background');
        my $bbg = $self->cget('-bookmarkcolor');
         
        my $nimf = $self->{NUMBERINF};
        for (@$nimf) {
                my $lab = $_;
                my $line = $lab->cget('-text');
                if ($self->bookmarked($line)) {
                        $lab->configure('-background', $bbg);
                } else {
                        $lab->configure('-background', $nbg);
                }
        }
}
HideShow 6 lines of Pod
=item B<bookmarked>I<($line)>
Returns true if line number I<$line?> is bookmarked.
=cut
sub bookmarked {
        my ($self, $line) = @_;
        my @range = $self->tagNextrange('BOOKMARK', "$line.0", "$line.0 lineend");
        return @range eq 2
}
sub bookmarkGo {
        my ($self, $line) = @_;
        return unless $self->bookmarked($line);
        $self->goTo("$line.0");
}
HideShow 6 lines of Pod
=item B<bookmarkList>
Returns a list of all bookmarked line numbers in the text.
=cut
sub bookmarkList {
        my $self = shift;
        my @list = ();
        my @ranges = $self->tagRanges('BOOKMARK');
        while (@ranges) {
                my $begin = shift @ranges;
                push @list, $self->linenumber($begin);
                shift @ranges;
        }
        return @list
}
sub bookmarkMenuItems {
        my $self = shift;
        my @items = ( 
                [command => '~Add bookmark',
                        -command => ['bookmarkNew', $self],
                ],
                [command => '~Remove bookmark',
                        -command => ['bookmarkRemove', $self],
                ],
                [command => '~Remove all bookmarks',
                        -command => ['bookmarkRemoveAll', $self],
                ],
                [separator => ''],
                [command => '~Next bookmark',
                        -command => ['bookmarkNext', $self],
                ],
                [command => '~Previous bookmark',
                        -command => ['bookmarkPrev', $self],
                ],
                [separator => ''],
        );
        return @items
}
sub bookmarkMenuPop {
        my ($self, $menu, $bmentry) = @_;
        #find bookmark submenu
        my $submenu;
        for(0 ..$menu->index('end')) {
                if ($menu->type($_) eq 'cascade') {
                        my $label = $menu->entrycget($_, '-label');
                        if ($label eq $bmentry) {
                                $submenu = $menu->entrycget($_, '-menu');
                                last;
                        }
                }
        } 
        #refresh the bookmarks menu
        if (defined $submenu) {
                #find first entry that is a bookmark
                my $first;
                for(0 ..$submenu->index('end')) {
                        next unless $submenu->type($_) eq 'command';
                        my $label = $submenu->entrycget($_, '-label');
                        if ($label =~ /^\d+/) {
                                $first = $_;
                                last;
                        }
                }
                #delete all bookmarks from the menu
                $submenu->delete($first, 'end') if defined $first;
                #add all current bookmarks
                my @bookmarks = $self->bookmarkList;
                for (@bookmarks) {
                        my $mark = $_;
                        $submenu->add('command',
                                -command => sub { $self->bookmarkGo($mark) },
                                -label => "$mark - " . $self->bookmarkText($mark),
                        );
                }
        } else {
                warn "Submenu $bmentry not found"
        }
}
HideShow 7 lines of Pod
=item B<bookmarkNew>
Same as B<bookmarkAdd> except it updates the visible bookmarks
in the line number column.
=cut
sub bookmarkNew {
        my $self = shift;
        $self->bookmarkAdd(@_);
        $self->bookmarkCheck;
}
HideShow 7 lines of Pod
=item B<bookmarkNext>I<(?$line?)>
Jumps to the next bookmark relative to line number I<$line>.
If you do not specify I<$line?>, the jump is made from the insert cursor position.
=cut
sub bookmarkNext {
        my ($self, $line) = @_;
        $line = $self->linenumber('insert') unless defined $line;
        my @list = $self->bookmarkList;
        for (@list) {
                my $next = $_;
                if ($next > $line) {
                        $self->bookmarkGo($next);
                        return
                }
        }
}
HideShow 7 lines of Pod
=item B<bookmarkPrev>I<(?$line?)>
Jumps to the previous bookmark relative to line number I<$line?>.
If you do not specify I<$line?>, the jump is made from the insert cursor position.
=cut
sub bookmarkPrev {
        my ($self, $line) = @_;
        $line = $self->linenumber('insert') unless defined $line;
        my @list = $self->bookmarkList;
        for (reverse @list) {
                my $prev = $_;
                if ($prev < $line) {
                        $self->bookmarkGo($prev);
                        return
                }
        }
}
HideShow 7 lines of Pod
=item B<bookmarkRemove>I<(?$line?)>
Removes the bookmark at I<$line?>. 
If you do not specify I<$line?>, the bookmark of the line that holds the insert cursor position is removed.
=cut
sub bookmarkRemove {
        my $self = shift;
        $self->bookmarkRemoveForce(@_);
        $self->bookmarkCheck;
}
HideShow 6 lines of Pod
=item B<bookmarkRemoveAll>
Removes all bookmarks. 
=cut
sub bookmarkRemoveAll {
        my $self = shift;
        my @list = $self->bookmarkList;
        for (@list) {
                $self->bookmarkRemove($_);
        }
        $self->bookmarkCheck;
}
sub bookmarkRemoveForce {
        my ($self, $line) = @_;
        $line = $self->linenumber('insert') unless defined $line;
        return unless $self->bookmarked($line);
        $self->tagRemove('BOOKMARK', "$line.0", "$line.0 lineend");
}
sub bookmarkText {
        my ($self, $line) = @_;
        my $text = $self->get("$line.0", "$line.0 lineend");
        $text =~ s/^\s+//; #remove leading spaces
        my $max = $self->cget('-bookmarksize');
        $text = substr($text, 0, $max) if length($text) > $max;
        return $text
}
HideShow 19 lines of Pod
=item B<canUndo>
Returns true if the undo stack has content.
=cut
=item B<canRedo>
Returns true if the redo stack has content.
=cut
=item B<clear>
Delets all text. Clears the undo and redo stack. Clears the modified flag.
Resets hightlighting to syntax 'None'
=cut
sub clear {
        my $self = shift;
        $self->Subwidget('XText')->clear;
        $self->Kamelon->Reset;
        $self->configure(-syntax => 'None');
}
sub Colored {
        my $self = shift;
        $self->{COLORED} = shift if @_;
        return $self->{COLORED}
}
sub ColorInf {
        my $self = shift;
        $self->{COLORINF} = shift if @_;
        return $self->{COLORINF}
}
HideShow 6 lines of Pod
=item B<comment>
Comments the current line or selection.
=cut
sub contentCheck {
        my $self = shift;
        $self->lnumberCheck;
#       $self->foldsCheck;
        $self->bookmarkCheck;
}
sub FindAndOrReplace {
        my ($self, $flag) = @_;
        my $geosave = $self->toplevel->geometry;
        my $sandr = $self->Subwidget('SandR');
        if ($flag) {
                $self->Subwidget('Replace')->packForget
        } else {
                $self->Subwidget('Replace')->pack(
                        -fill => 'x',
                );
        }
        $sandr->pack(
                -fill => 'x',
                -before => $self->Subwidget('Statusbar'),
        );
        $self->Subwidget('FindEntry')->focus;
        $self->toplevel->geometry($geosave);
}
sub FindClose {
        my $self = shift;
        $self->FindClear;
        $self->Subwidget('XText')->focus;
        $self->Subwidget('SandR')->packForget;
        $self->tagRemove('Find', '1.0', 'end');
}
HideShow 7 lines of Pod
=item B<fixIndent>
Works on the entire text unless a selection is set. In that case works only on the selection.
Checks all lines in the working range for incorrect indentation and attempts to repair.
=cut
sub fixIndent {
        my ($self, $icon) = @_;
        my ($begin, $end) = $self->getRange;
        #pop the dialog
        my @padding = (-padx => 10, -pady => 10);
        my $q = $self->{POPSPACESPERTABS};
        unless (defined $q) {
                $q = $self->YADialog(
                        -title => 'Fix indent',
                        -buttons => [qw(Ok Cancel)],
                );
                $q->Label(-image => $icon)->pack(-side => 'left', @padding) if defined $icon;
                my $f = $q->Frame->pack(-side => 'left', @padding);
                $f->Label(
                        -anchor => 'w',
                        -text => 'Spaces per tab',
                )->pack(-fill => 'x', -padx => 2, -pady => 2);
                my $e = $f->Entry->pack(-fill => 'x', -padx => 2, -pady => 2);
                $self->{POPENTRY} = $e;
                $e->focus;
                $e->bind('<Return>', sub { 
                        $q->{PRESSED} = 'Ok' 
                });
                $self->{POPSPACESPERTABS} = $q;
        }
         
        my $answer = $q->Show(-popover => $self->toplevel);
        if ($answer eq 'Ok') {
                my $spaces_per_tab = $self->{POPENTRY}->get;
                return unless $spaces_per_tab =~ /^\d+$/;
                 
                for ($begin .. $end) {
                        my $line = $_;
                        my $b = $self->index("$line.0");
                        my $e = $self->index("$line.0 lineend");
                        my $text = $self->get($b, $e);
                         
                        if ($text =~ /^([\s|\t]+)/) {
                                my $spaces = $1;
                                my $s = 0;
                                my $pos = 0;
                                my $itext = '';
                                $itext = "$itext " while length($itext) ne $spaces_per_tab;
                                while ($spaces ne '') {
                                        my $char = substr $spaces, 0, 1, '';
                                        if ($self->cget('-indentstyle') eq 'tab') {
                                                if ($char eq "\t") {
                                                        $s = 0;
                                                } else {
                                                        $s ++;
                                                        if ($s eq $spaces_per_tab) {
                                                                my $linepos = $self->index("$b + $pos c");
                                                                $self->replace($linepos, "$linepos + $s c", "\t");
                                                                $s = 0;
                                                                $pos ++;
                                                        }
                                                }
                                        } else {
                                                if ($char eq "\t") {
                                                        my $linepos = $self->index("$b + $pos c");
                                                        $self->replace($linepos, "$linepos + 1 c", $itext);
                                                        $pos = $pos + length($itext) - 1;
                                                }
                                                $pos ++
                                        }
                                }
                        }
                }
        }
}
sub foldButton {
        my ($self, $line) = @_;
        my $folds = $self->Kamelon->Formatter->Folds;
        my $fbuttons = $self->FoldButtons;
        unless (exists $fbuttons->{$line}) {
                my $data = $folds->{$line};
                my @opt = ();
                my $state;
                if ($self->isHidden($line + 1)) {
                        push @opt, -image => $self->cget('-plusimg');
                        $state = 'collapsed';
                } else {
                        push @opt, -image => $self->cget('-minusimg');
                        $state = 'expanded';
                }
                my $b = $self->Subwidget('Folds')->Button(@opt,
                        -command => ['foldFlip', $self, $line],
                        -relief => 'flat',
                );
                $fbuttons->{$line} = {
                        button => $b,
                        data => $data,
                        state => $state,
                };
        }
        return $fbuttons->{$line};
}
sub FoldButtons {
        my $self = shift;
        $self->{FOLDBUTTONS} = shift if @_;
        return $self->{FOLDBUTTONS}
}
sub foldCollapse {
        my ($self, $line) = @_;
        my $data = $self->FoldButtons->{$line};
        $data->{'state'} = 'collapsed';
        $data->{'button'}->configure(-image => $self->cget('-plusimg'));
        my $end = $data->{'data'}->{'end'};
        $line ++;
        while ($line <= $end) {
                $self->hideLine($line);
                $line ++;
        }
        $self->lnumberCheck;
        $self->foldsCheck;
}
HideShow 6 lines of Pod
=item B<foldCollapseAll>
Collapses all folding points.
=cut
sub foldCollapseAll {
        my $self = shift;
        my $folds = $self->Kamelon->Formatter->Folds;
        for (sort keys %$folds) {
                $self->foldButton($_); #just make sure a fold button exists
                $self->foldCollapse($_);
        }
}
sub foldExpand {
        my ($self, $line) = @_;
        my $data = $self->FoldButtons->{$line};
        $data->{'state'} = 'expanded';
        $data->{'button'}->configure(-image => $self->cget('-minusimg'));
        $self->lnumberCheck;
        my $end = $data->{'data'}->{'end'};
        $line ++;
        while ($line <= $end) {
                $self->showLine($line);
                my $nested = $self->FoldButtons->{$line};
                if (defined $nested) {
                        $self->foldExpand($line) unless ($nested->{'state'} eq 'collapsed');
                        $line = $nested->{'data'}->{'end'};
                        $self->showLine($line);
                } else {
                        $line ++
                }
        }
        $self->foldsCheck;
}
HideShow 6 lines of Pod
=item B<foldExpandAll>
Expands all folding points.
=cut
sub foldExpandAll {
        my $self = shift;
        my $folds = $self->Kamelon->Formatter->Folds;
        for (sort keys %$folds) {
                $self->foldButton($_); #just make sure a fold button exists
                $self->foldExpand($_);
        }
}
sub foldFlip {
        my ($self, $line) = @_;
        my $data = $self->FoldButtons->{$line};
        if ($data->{'state'} eq 'collapsed') {
                $self->foldExpand($line);
        } elsif ($data->{'state'} eq 'expanded') {
                $self->foldCollapse($line);
        }
}
sub foldsCheck {
        my $self = shift;
        return unless $self->cget('-showfolds');
        my $line = $self->visualBegin;
        my $last = $self->visualEnd;
        return if $self->Colored < $last;
        my $folds = $self->Kamelon->Formatter->Folds;
        my $fframe = $self->Subwidget('Folds');
        my $btns = $self->FoldButtons;
        #clear out out of sight fold buttons
        for (keys %$btns) {
                if (($_ < $self->visualBegin) or ($_ > $self->visualEnd)) {
                        my $b = delete $btns->{$_};
                        $b->{'button'}->destroy;
                }
        }
        my @shown = ();
        while ($line <= $last) {
                while ($self->isHidden($line)) { $line ++ }
                if (exists $folds->{$line}) {
                        #vertical alignment with the line
                        my ( $x, $y, $wi, $he ) = $self->dlineinfo("$line.0");
                        my $but = $self->foldButton($line)->{'button'};
                        my $bh = $but->reqheight;
                        my $delta = int(($he - $bh) / 2);
                        $but->place(-x => 0, -y => $y + $delta);
                        push @shown, $but;
                } elsif (exists $btns->{$line}) {
                        my $b = delete $btns->{$line};
                        $b->{'button'}->destroy;
                } else {
                }
                $line ++;
        }
        $self->{FOLDSSHOWN} = \@shown;
}
sub foldsClear {
        my $self = shift;
        my $shown = $self->{FOLDSSHOWN};
        for (@$shown) { 
                $_->placeForget;
        }
        $self->{FOLDSSHOWN} = [];
}
sub foldsMenuPop {
        my ($self, $x, $y) = @_;
        $self->Subwidget('Foldsmenu')->post($x - 2, $y - 2);
}
sub font {
        my $self = shift;
        my $xt = $self->Subwidget('XText');
        if (@_) {
                my $new = shift;
                $xt->configure('-font', $new);
                my $inf = $self->{NUMBERINF};
                for (@$inf) {
                        $_->configure('-font', $new);
                }
                $self->update if $self->{POSTCONFIG};
                $self->lnumberCheck(1);
        }
        return $xt->cget('-font');
}
HideShow 7 lines of Pod
=item B<fontCompose>I<($font, %options)>
Returns a new font based on $font.
The keys -family -size -weight -slant are supported 
=cut
sub fontCompose {
        my ($self, $font, %options) = @_;
        my $family = $self->fontActual($font, '-family');
        my $size = $self->fontActual($font, '-size');
        my $weight = '';
        my $slant = '';
        $slant = $options{'-slant'} if exists $options{'-slant'};
        $weight = $options{'-weight'} if exists $options{'-weight'};
        $slant = 'roman' if $slant eq '';
        $weight = 'normal' if $weight eq '';
        return $self->Font(
                -family => $family,
                -size => $size,
                -slant => $slant,
                -weight => $weight,
        );
}
HideShow 14 lines of Pod
=item B<getFontInfo>
Returns info about the font used in the text widget.
The info is a hash with keys -family -size -weight -slant -underline -overstrike. 
=cut
=item B<getRange>
Checks for a selection and returns the line numbers of the begin and the end. If no selection is set
it returns 1 and the line number of the last line.
=cut
sub getRange {
        my $self = shift;
        my $begin = 1;
        my $end = $self->linenumber('end - 1c');
        my @sel = $self->tagRanges('sel');
        if (@sel) {
                $begin = $self->linenumber(shift @sel);
                $end = $self->linenumber(shift @sel);
        }
        return ($begin, $end);
}
HideShow 6 lines of Pod
=item B<goTo>I<($index)>
Sets the insert cursor to $index.
=cut
sub hideLine {
        my ($self, $line) = @_;
        $self->tagAdd('Hidden', "$line.0", "$line.0 lineend + 1c");
}
sub highlightCheck {
        my ($self, $pos) = @_;
        return if $self->NoHighlighting;
        my $line = $self->linenumber($pos);
        my $colored = $self->Colored;
        $self->highlightPurge($line) if $line <= $self->Colored;
}
sub highlightinterval {
        my $self = shift;
        $self->{HIGHLIGHTINTERVAL} = shift if @_;
        return $self->{HIGHLIGHTINTERVAL}
}
sub highlightLine {
        my ($self, $num) = @_;
        my $kam = $self->Kamelon;
        $kam->LineNumber($num);
        my $xt = $self->Subwidget('XText');
        my $begin = "$num.0"; 
        my $end = $xt->index("$num.0 lineend + 1c");
        my $cli = $self->ColorInf;
        my $k = $cli->[$num - 1];
        $kam->StateSet(@$k);
        my $txt = $xt->get($begin, $end); #get the text to be highlighted
        if ($txt ne '') { #if the line is not empty
                my $pos = 0;
                my $start = 0;
                my @h = $kam->ParseRaw($txt);
                while (@h ne 0) {
                        $start = $pos;
                        $pos += length(shift @h);
                        my $tag = shift @h;
                        $xt->tagAdd($tag, "$num.$start", "$num.$pos");
                };
                $xt->tagRaise('Find');
                $xt->tagRaise('Space');
                $xt->tagRaise('Tab');
                $xt->tagRaise('sel');
        };
        $cli->[$num] = [ $kam->StateGet ];
#       $self->foldsCheck if $num eq $self->visualEnd;
}
sub highlightLoop {
        my $self = shift;
        if ($self->NoHighlighting) {
                $self->LoopActive(0);
                return
        }
        my $xt = $self->Subwidget('XText');
        my $lpc = $self->cget('-linespercycle');
        my $colored = $self->Colored;
        $self->highlightRemove($colored, $colored + $lpc);
        for (1 .. $lpc) {
                my $colored = $self->Colored;
                if ($colored <= $xt->linenumber('end - 1c')) {
                        $self->LoopActive(1);
                        $self->highlightLine($colored);
                        $colored ++;
                        $self->Colored($colored);
                } else {
                        $self->after(100, ['foldsCheck', $self]);
                        $self->LoopActive(0);
                }
                last unless $self->LoopActive;
        }
        $self->after($self->highlightinterval, ['highlightLoop', $self]) if $self->LoopActive;
}
sub highlightPurge {
        my ($self, $line, $remove) = @_;
        $line = 1 unless defined $line;
        $remove = 0 unless defined $remove;
        #purge highlightinfo
        $self->highlightRemove($line) if $remove;
        $self->Colored($line);
        my $cli = $self->ColorInf;
        if (@$cli) { splice(@$cli, $line) };
                 
        #purge folds
        my $folds = $self->Kamelon->Formatter->Folds;
        for (keys %$folds) {
                delete $folds->{$_} if $_ >= $line
        }
        $self->highlightLoop unless $self->LoopActive;
}
sub highlightRemove {
        my ($self, $begin, $end) = @_;
        $begin = 1 unless defined $begin;
        $end = $self->linenumber('end') unless defined $end;
        $begin = "$begin.0";
        $end = $self->index("$end.0 lineend");
         
        for ($self->tags) {
                $self->tagRemove($_, $begin, $end)
        }
}
HideShow 10 lines of Pod
=item B<indent>
Indents the current line or selection.
=item B<isHidden>I<($line)>
Returns true if $line is hidden by a colde fold.
=cut
sub isHidden {
        my ($self, $line) = @_;
        my @names = $self->tagNames("$line.0");
        my $hit = grep({ $_ eq 'Hidden'} @names);
        return $hit;
}
sub Kamelon {
        return $_[0]->{KAMELON}
}
HideShow 6 lines of Pod
=item B<linenumber>I<($index)>
Returns the line number of $index.
=cut
sub linespercycle {
        my $self = shift;
        $self->{LINESPERCYCLE} = shift if @_;
        return $self->{LINESPERCYCLE}
}
HideShow 6 lines of Pod
=item B<lineVisible>I<($line)>
Returns true if line $line is visible on the display.
=cut
sub lineVisible {
        my ($self, $line) = @_;
        my $first = $self->visualBegin;
        my $last = $self->visualEnd;
        return (($line >= $first) and ($line <= $last))
}
sub lnumberCheck {
        my ($self, $force) = @_;
        $force = 0 unless defined $force;
        my $line = $self->visualBegin;
        my $last = $self->visualEnd;
        my $sb = $self->SaveFirstVisible;
        my $se = $self->SaveLastVisible;
        unless ($force) {
                return if ($sb eq $line) and ($last eq $se);
        }
        return unless $self->{POSTCONFIG};
        return unless $self->cget('-shownumbers');
        $self->SaveFirstVisible($line);
        $self->SaveLastVisible($last);
        my $widget = $self->Subwidget('XText');
        my $count = 0;
        my $font = $widget->cget('-font');
        my $nimf = $self->{NUMBERINF};
        my $numframe = $self->Subwidget('Numbers');
        while ($line <= $last) {
                while ($self->isHidden($line)) { $line ++ }
                my ( $x, $y, $wi, $he ) = $self->dlineinfo("$line.0");
                #create a number label if it does not yet exist;
                unless (defined $nimf->[$count]) {
                        my $l = $numframe->Label(
                                -justify => 'right',
                                -anchor => 'ne',
                                -font => $font,
                                -borderwidth => 0,
                        );
                        push @$nimf, $l;
                }
                #configure and position the number label
                my $lab = $nimf->[$count];
                $lab->configure(
                        -text => $line,
                        -width => length($last),
                );
                $lab->placeForget if $lab->ismapped;
                $lab->place(-x => 0, -y => $y);
                $line ++;
                $count ++;
        }
        my $numwidth = $nimf->[$count - 1]->reqwidth;
        $numframe->configure(-width => $numwidth);
        #remove redundant nummber labels
        while (defined $nimf->[$count]) {
                my $l = pop @$nimf;
                $l->placeForget;
                $l->destroy;
        }
}
HideShow 7 lines of Pod
=item B<load>I<($file)>
Clears the text widget and loads $file.
Returns 1 if successfull.
=cut
sub load{
        my ($self, $file) = @_;
        if ($self->Subwidget('XText')->load($file)) {
                my $syntax = $self->Kamelon->SuggestSyntax($file);
                $self->configure(-syntax => $syntax) if defined $syntax;
                $self->after(500, ['contentCheck', $self]);
                return 1
        }
        return 0
}
sub LoopActive {
        my $self = shift;
        $self->{LOOPACTIVE} = shift if @_;
        return $self->{LOOPACTIVE}
}
sub NoHighlighting {
        my $self = shift;
        $self->{NOHIGHLIGHTING} = shift if @_;
        return $self->{NOHIGHLIGHTING}
}
sub OnModify {
        my ($self, $index) = @_;
        $self->highlightCheck($index);
        $self->bookmarkCheck;
        $self->spacesCheck($index);
        $self->Callback('-modifiedcall', $index);
}
sub position {
        my ($self, $pos) = @_;
        if (defined $pos) {
                $self->goTo($pos);
                $self->see($pos);
        }
        return $self->index('insert');
}
HideShow 18 lines of Pod
=item B<redo>
Redoes the last undo.
=item B<replace>I<$begin, $end, $string)>
Replaces the text from index I<$begin> to I<$end> with the text in I<$string>. 
Counts for one event in the undo stack.
=cut
=item B<removeTrailingSpaces>
Works on the entire text unless a selection is set. In that case works only on the selection.
Checks all lines in the working range for trailing spaces or tabs and removes them.
=cut
sub removeTrailingSpaces {
        my $self = shift;
        my ($begin, $end) = $self->getRange;
        for ($begin .. $end) {
                my $line = $_;
                my $b = $self->index("$line.0");
                my $e = $self->index("$line.0 lineend");
                my $text = $self->get($b, $e);
                if ($text =~ /(\s+)$/) {
                        my $spaces = $1;
                        my $l = length($spaces);
                        $self->delete("$e - $l c", $e);
                }
        }
}
HideShow 10 lines of Pod
=item B<save>I<($file)>
Saves the text into $file. Returns 1 if successfull.
=item B<saveExport>I<($file)>
Same as save, except it does not clear the modified flag.
=cut
sub SaveFirstVisible {
        my $self = shift;
        $self->{SAVEFIRSTVISIBLE} = shift if @_;
        return $self->{SAVEFIRSTVISIBLE}
}
sub SaveLastVisible {
        my $self = shift;
        $self->{SAVELASTVISIBLE} = shift if @_;
        return $self->{SAVELASTVISIBLE}
}
HideShow 6 lines of Pod
=item B<selectionExists>
Returns true if a selection exists
=cut
sub showfolds {
        my ($self, $flag) = @_;
        my $f = $self->Subwidget('Folds');
        if (defined $flag) {
                if ($flag) {
                        my $before = $self->Subwidget('XText');
                        $f->pack(
                                -side => 'left',
                                -before => $before,
                                -fill => 'y',
                        );
                        $self->{FOLDSVISIBLE} = 1;
                        $self->foldsCheck;
                } else {
                        $self->{FOLDSVISIBLE} = 0;
                        $f->packForget;
                }
        }
        return $self->{FOLDSVISIBLE}
}
sub showLine {
        my ($self, $line) = @_;
        $self->tagRemove('Hidden', "$line.0", "$line.0 lineend + 1c");
}
sub shownumbers {
        my ($self, $flag) = @_;
        my $f = $self->Subwidget('Numbers');
        if (defined $flag) {
                if ($flag) {
                        my $before = $self->Subwidget('XText');
                        $before = $self->Subwidget('Folds') if $self->{FOLDSVISIBLE};
                        $f->pack(
                                -side => 'left',
                                -before => $before,
                                -fill => 'y',
                        );
                        $self->{NUMBERSVISIBLE} = 1;
                        $self->lnumberCheck;
                } else {
                        $f->packForget;
                        $self->{NUMBERSVISIBLE} = 0;
                }
        }
        return $self->{NUMBERSVISIBLE}
}
sub showspaces {
        my $self = shift;
        if (@_) {
                $self->{SHOWSPACES} = shift;
                $self->spacesPurge(1, 1) if $self->{POSTCONFIG};
        }
        return $self->{SHOWSPACES}
}
sub showstatus {
        my ($self, $flag) = @_;
        my $f = $self->Subwidget('Statusbar');
        if (defined $flag) {
                if ($flag) {
                        $f->pack(
                                -fill => 'x',
                        );
                        $self->{STATUSVISIBLE} = 1;
                        $f->updateStatus;
                } else {
                        $f->packForget;
                        $self->{STATUSVISIBLE} = 0;
                }
        }
        return $self->{STATUSVISIBLE};
}
sub spacebackground {
        my $self = shift;
        if (@_) {
                $self->tagConfigure('Space', -background => shift);
        }
        return $self->tagCget('Space', '-background');
}
sub spacesCheck {
        my ($self, $pos) = @_;
        return unless $self->cget('-showspaces');
        my $line = $self->linenumber($pos);
        my $completed = $self->spacesCompleted;
        $self->spacesPurge($line) if $line <= $self->spacesCompleted;
}
sub spacesCompleted {
        my $self = shift;
        $self->{SPACESCOMPLETED} = shift if @_;
        return $self->{SPACESCOMPLETED}
}
sub spacesLine {
        my ($self, $line) = @_;
        my $begin = $self->index("$line.0");
        my $end = $self->index("$begin lineend");
        my $text = $self->get($begin, $end);
        for ('Space', 'Tab') {
                $self->tagRemove($_, $begin, $end)
        }
        if ($text =~ /^([\s|\t]+)/) {
                my $spaces = $1;
                my $count = 0;
                while ($spaces ne '') {
                        my $char = substr $spaces, 0, 1, '';
                        my $next = $count + 1;
                        $self->tagAdd('Space', "$begin + $count c", "$begin + $next c") if $char eq ' ';
                        $self->tagAdd('Tab', "$begin + $count c", "$begin + $next c") if $char eq "\t";
                        $count ++
                }
        }
        if ($text =~ /(\s+)$/) {
                my $spaces = $1;
                my $l = length($spaces);
                $end = $self->index("$end - $l c");
                my $count = 0;
                while ($spaces ne '') {
                        my $char = substr $spaces, 0, 1, '';
                        my $next = $count + 1;
                        $self->tagAdd('Space', "$end + $count c", "$end + $next c") if $char eq ' ';
                        $self->tagAdd('Tab', "$end + $count c", "$end + $next c") if $char eq "\t";
                        $count ++
                }
        }
        $self->tagRaise('Space');
        $self->tagRaise('Tab');
        $self->tagRaise('Find');
        $self->tagRaise('sel');
}
sub spacesLoop {
        my $self = shift;
        unless ($self->cget('-showspaces')) {
                $self->spacesLoopActive(0);
                return
        }
        my $xt = $self->Subwidget('XText');
        my $lpc = $self->cget('-linespercycle');
        my $complete = $self->spacesCompleted;
        $self->spacesRemove($complete, $complete + $lpc);
        for (1 .. $lpc) {
                my $complete = $self->spacesCompleted;
                if ($complete <= $xt->linenumber('end - 1c')) {
                        $self->spacesLoopActive(1);
                        $self->spacesLine($complete);
                        $complete ++;
                        $self->spacesCompleted($complete);
                } else {
                        $self->spacesLoopActive(0);
                }
                last unless $self->spacesLoopActive;
        }
        $self->after($self->highlightinterval, ['spacesLoop', $self]) if $self->spacesLoopActive;
}
sub spacesLoopActive {
        my $self = shift;
        $self->{SPACESLOOPACTIVE} = shift if @_;
        return $self->{SPACESLOOPACTIVE}
}
sub spacesPurge {
        my ($self, $line, $remove) = @_;
        $line = 1 unless defined $line;
        $remove = 0 unless defined $remove;
        $self->spacesRemove($line) if $remove;
        $self->spacesCompleted($line);
        $self->spacesLoop unless $self->spacesLoopActive;
}
sub spacesRemove {
        my ($self, $begin, $end) = @_;
        $begin = 1 unless defined $begin;
        $end = $self->linenumber('end') unless defined $end;
        $begin = "$begin.0";
        $end = $self->index("$end.0 lineend");
         
        for ('Space', 'Tab') {
                $self->tagRemove($_, $begin, $end)
        }
}
sub syntax {
        my ($self, $new) = @_;
        my $kam = $self->Kamelon;
        if (defined($new)) {
                $self->NoHighlighting(1);
                $self->highlightPurge(1, 1);
                $self->Subwidget('XText')->configure(
                        -mlcommentend => undef,
                        -mlcommentstart => undef,
                        -slcomment => undef,
                );
                unless ($new eq 'None') {
                        $kam->Syntax($new);
                        my $idx = $kam->GetIndexer;
                        $self->Subwidget('XText')->configure(
                                -mlcommentend => $idx->InfoMLCommentEnd($new),
                                -mlcommentstart => $idx->InfoMLCommentStart($new),
                                -slcomment => $idx->InfoSLComment($new),
                        );
                        $self->NoHighlighting(0);
                        $self->Colored(0);
                        $self->ColorInf([ [$kam->StateGet] ]);
                        $self->highlightLoop unless $self->LoopActive;
                }
                $self->{SYNTAX} = $new;
        }
        return $self->{SYNTAX}
}
sub tabbackground {
        my $self = shift;
        if (@_) {
                $self->tagConfigure('Tab', -background => shift);
        }
        return $self->tagCget('Tab', '-background');
}
HideShow 6 lines of Pod
=item B<tags>
Returns the Kamelon list of AvailableAttributes.
=cut
sub tags {
        return $_[0]->Kamelon->AvailableAttributes
}
HideShow 7 lines of Pod
=item B<theme>
Returns a reference to the current theme object.
See also L<Tk::CodeText::Theme>
=cut
sub theme {
        return $_[0]->{THEME}
}
HideShow 6 lines of Pod
=item B<themeDialog>
Initiates a dialog for editing the colors and font information for highlighting.
=cut
sub themeDialog {
        my $self = shift;
        my $theme = $self->theme;
        my $dialog = $self->DialogBox(
                -title => 'Theme editor',
                -buttons => ['Ok', 'Cancel'],
                -default_button => 'Ok',
                -cancel_button => 'Cancel',
        );
        my $historyfile;
        my $config = $self->cget('-configdir');
        $historyfile = "$config/recent_colors";
        my $editor = $dialog->add('TagsEditor',
                -defaultbackground => $self->Subwidget('XText')->cget('-background'),
                -defaultforeground => $self->Subwidget('XText')->cget('-foreground'),
                -defaultfont => $self->Subwidget('XText')->cget('-font'),
                -historyfile => $historyfile,
                -relief => 'sunken',
                -borderwidth => 2,
                -width => 62,
        )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2);
        my $toolframe =  $dialog->add('Frame',
        )->pack(-fill => 'x');
        $toolframe->Button(
                -command => sub {
                        my $file = $self->getSaveFile(
                                -filetypes => [
                                        ['Highlight Theme' => '.ctt'],
                                ],
                        );
                        $editor->save($file) if defined $file;
                },
                -text => 'Save',
        )->pack(-side => 'left', -padx => 5, -pady => 5);
        $toolframe->Button(
                -text => 'Load',
                -command => sub {
                        my $file = $self->getOpenFile(
                                -filetypes => [
                                        ['Highlight Theme' => '.ctt'],
                                ],
                        );
                        if (defined $file) {
                                my $obj = Tk::CodeText::Theme->new;
                                $obj->load($file);
                                $editor->put($obj->get);
                                $editor->updateAll
                        }
                },
        )->pack(-side => 'left', -padx => 5, -pady => 5);
         
        $editor->put($theme->get);
        my $button = $dialog->Show(-popover => $self);
        if ($button eq 'Ok') {
                $theme->put($editor->get);
                $self->themeUpdate;
        }
        $dialog->destroy;
}
sub themefile {
        my $self = shift;
        if (@_) {
                my $file = shift;
                if ((defined $file) and (-e $file)) {
                        $self->theme->load($file);
                        #the ->after is necessary here, at create time the widget would not yet return the
                        #correct font information to configure the tags correctly.
                        #TODO: find a solution for this.
                        $self->after(1, ['themeUpdate', $self]);;
                }
                $self->{THEMEFILE} = $file;
        }
        return $self->{THEMEFILE};
}
sub themeUpdate {
        my $self = shift;
        my $theme = $self->theme;
        my @values = $theme->get;
        my $font = $self->cget('-font');
        my $bg = $self->Subwidget('XText')->cget('-background');
        my $fg = $self->Subwidget('XText')->cget('-foreground');
        for ($theme->tagList) { $self->tagDelete($_) }
        while (@values) {
                my $tag = shift @values;
                my $options = shift @values;
                my %opt = @$options;
                my $nbg = $bg;
                my $nfg = $fg;
                my $nfont = $font;
                $nbg = $opt{'-background'} if exists $opt{'-background'};
                $nfg = $opt{'-foreground'} if exists $opt{'-foreground'};
                $nfont = $self->fontCompose($nfont, -slant => $opt{'-slant'}) if exists $opt{'-slant'};
                $nfont = $self->fontCompose($nfont, -weight => $opt{'-weight'}) if exists $opt{'-weight'};
                $self->tagConfigure($tag,
                        -background => $nbg,
                        -foreground => $nfg,
                        -font => $nfont,
                );
        }
        $self->highlightPurge(1);
}
HideShow 14 lines of Pod
=item B<uncomment>
Uncomments the current line or selection.
=item B<undo>
Undoes the last edit operation.
=item B<unindent>
Unintents the current line or selection
=cut
sub ViewMenuItems {
        my $self = shift;
        my $a;
        tie $a, 'Tk::Configure', $self, '-autoindent';
        my $b;
        tie $b, 'Tk::Configure', $self, '-autobrackets';
        my $c;
        tie $c, 'Tk::Configure', $self, '-autocomplete';
        my $d;
        tie $d, 'Tk::Configure', $self, '-showspaces';
        my $f;
        tie $f, 'Tk::Configure', $self, '-showfolds';
        my $n;
        tie $n, 'Tk::Configure', $self, '-shownumbers';
        my $s;
        tie $s, 'Tk::Configure', $self, '-showstatus';
        my $v = $self->cget('-wrap');
        Tie::Watch->new(
                -variable => \$v,
                -store => sub {
                        my ($watch, $value) = @_;
                        $watch->Store($value);
                        $self->configure(-wrap => $v);
                        $self->contentCheck;
                },
        );
        my @values = (-onvalue => 1, -offvalue => 0);
        my $match = $self->cget('-match');
        my $curlies = '';
        $curlies = '{}' if $match =~ /\{\}/;
        my $paren = '';
        $paren = '()' if $match =~ /\(\)/;
        my $brackets = '';
        $brackets = '[]' if $match =~ /\[\]/;
        my @opt = (
                -command => sub  { $self->configure('-match',  $curlies . $paren . $brackets) },
                -offvalue => '',
        );
        my @items = ( 
                [checkbutton => '~Auto indent', @values, -variable => \$a],
                [checkbutton => '~Auto brackets', @values, -variable => \$b],
                [checkbutton => 'A~uto complete', @values, -variable => \$c],
                [checkbutton => '~Show spaces and tabs', @values, -variable => \$d],
                ['cascade'=> '~Wrap', -tearoff => 0, -menuitems => [
                        [radiobutton => 'Word', -variable => \$v, -value => 'word'],
                        [radiobutton => 'Character', -variable => \$v, -value => 'char'],
                        [radiobutton => 'None', -variable => \$v, -value => 'none'],
                ]],
                ['cascade'=> '~Match', -tearoff => 0, -menuitems => [
                        [checkbutton => '() Parenthesis', @opt, -variable => \$paren, -onvalue => '()'],
                        [checkbutton => '{} Curlies', @opt, -variable => \$curlies, -onvalue => '{}'],
                        [checkbutton => '[] Brackets',@opt, -variable => \$brackets, -onvalue => '[]'],
                ]],
                [command => 'Au~to complete settings', -command => [acSettings => $self]],
                [command => '~Colors', -command => [themeDialog => $self]],
                'separator',
                [checkbutton => 'Code ~folds', @values, -variable => \$f],
                [checkbutton => '~Line numbers', @values, -variable => \$n],
                [checkbutton => '~Status bar', @values, -variable => \$s],
                'separator',
                [command => '~Fix indentation', -command => [fixIndent => $self]],
                [command => '~Remove trailing spaces', -command => [removeTrailingSpaces => $self]],
        );
        return @items
}
HideShow 43 lines of Pod
=item B<visualBegin>
Returns the line number of the first visible line.
=cut
=item B<visualEnd>
Returns the line number of the last visible line.
=cut
=back
=head1 EXECUTABLES
This module packs an executable, B<codetext>. It is a simple Notepad like editor but with all the features
of B<Tk::CodeText>. Type 'codetext -h' in the command line for options.
=head1 AUTHOR
Hans Jeuken (hanje at cpan dot org)
=head1 BUGS AND CAVEATS
Matching {}, [] and () does not take strings with matchable symbols into account.
If you find any, please contact the author.
=head1 SEE ALSO
=over 4
=item L<Tk::Text>
=item L<Tk::XText>
=item L<Syntax::Kamelon::Syntaxes>
=back
=cut
1;
__END__