#!/usr/bin/perl -w
use strict;
use File::Find;
use Tk;
use Tk::NoteBook;
use Tk::ROText;
use Storable;
use Fcntl;
if (defined $ARGV[0]) {unless (defined($ARGV[1])) {die "Filename extension required with path...\n"}}
my $show=0; my $slink=1;
my $CXdir="$ENV{HOME}/tkcodex";
my $VWgeom="1200x800+0+0";
my $VWwidth=1200; my $VWheight=800;
my %subrxp=("c,h"=>'(^)(([\w\*]+\s)+\(.*\))\s{',
"pl"=>'(^\s*sub )(\w+)\s*{');
my $bmfile="$CXdir/tkcodex.bookmarks";
if (-o("$ENV{HOME}/.tkcodex-config")) {process_config("$ENV{HOME}/.tkcodex-config")}
if ($show==1) {
print "\nConfiguration set:\n\tnote directory: \"$CXdir\"\n\tgeometry: \"$VWgeom\"\n";
foreach (keys %subrxp) {print "\tsubrountine regexp for \"$_\": \"$subrxp{$_}\"\n"}
print "\tbookmarks: \"$bmfile\"\n";
}
my $MW = MainWindow->new;
$MW->title("TkCodex");
$MW->setPalette(background=>'#ffffff',foreground=>'#360C7A',activeForeground=>'black',activeBackground=>'#FF0000',selectBackground=>'yellow',selectForeground=>'#00aa00');
my (%files, %info, %loc);
my $dir_EN = $MW->Entry(-width=>37,-takefocus=>'0');
$dir_EN->configure(-background=>'#BBFFBB',-foreground=>'#360C7A');
$dir_EN->bind("<Control-a>"=>sub{messagemain(\&bookmarks, 'add')});
$dir_EN->bind("<Control-d>"=>sub{messagemain(\&bookmarks, 'subtract')});
$dir_EN->bind("<Key-Up>"=>sub{bookmarks('move','-1')});
$dir_EN->bind("<Key-Down>"=>sub{bookmarks('move','1')});
my $suf_EN = $MW->Entry(-width=>15,-takefocus=>'0');
$suf_EN->configure(-background=>'#BBFFBB',-foreground=>'#360C7A');
my $reg_EN = $MW->Entry(-takefocus=>'0');
$reg_EN->configure(-background=>'#BBFFBB',-foreground=>'#360C7A');
my $regexp="";
my $TEhist = tkhistory(\$reg_EN,"new");
$reg_EN->bind("<Key-Up>"=>sub{tkhistory(\$reg_EN,"up", $TEhist)});
$reg_EN->bind("<Key-Down>"=>sub{tkhistory(\$reg_EN,"down", $TEhist)});
my @dirray; my $list=\@dirray;
my $DLB = $MW->Listbox(-height=>12,-width=>37,-listvariable=>$list,-takefocus=>'1');
$DLB->configure(-background=>'#BBBBFF',-foreground=>'#000000');
$DLB->bind($DLB,"1"=>sub{addto(0)});
$DLB->bind($DLB,"2"=>sub{addto(1)});
$DLB->bind($DLB,"3"=>sub{addto(2)});
$DLB->bind($DLB,"<<ListboxSelect>>"=>sub{showloc()});
my $dir_BT = $MW->Button(-text=>'dir',-font=>'courier-14',-command=>sub{$reg_EN->delete('0','end'); $regexp = "";
messagemain(\&fillbox)});
$dir_BT->configure(-background=>'#360C7A',-foreground=>'#EEFA3F');
my $regexp_BT = $MW->Button(-text=>'regexp',-font=>'courier-14',-command=>sub{ tkhistory(\$reg_EN, "add", $TEhist);
messagemain(\&trimbox)});
$regexp_BT->configure(-background=>'#360C7A',-foreground=>'#EEFA3F');
my $CLEARALL_BT = $MW->Button(-text=>'CLEARALL',-font=>'courier-14',-command=>sub{foreach (0..2) {clearall("all-$_")}});
$CLEARALL_BT->configure(-background=>'#360C7A',-foreground=>'#EEFA3F');
my $loctxt="";
my $suf_lab = $MW->Label(-text=>'suffix:',-font=>'courier-14');
my $loc_lab = $MW->Label(-textvariable=>\$loctxt,-font=>'helvetica 16 bold',-foreground=>'#cc0000');
my $case = "nocase";
my $case_CB = $MW -> Checkbutton(-text=>'case',-variable=>\$case,-onvalue=>"case",-offvalue=>"nocase",-command=>sub{caselight()},-font=>"courier-14");
$dir_EN->grid(-row=>0,-column=>0,-columnspan=>4);
$suf_lab->grid(-row=>1,-column=>0,-sticky=>'e');
$suf_EN->grid(-row=>1,-column=>1,-sticky=>'w',-columnspan=>2);
$dir_BT->grid(-row=>1,-column=>3);
$DLB->grid(-row=>2,-column=>0,-columnspan=>4);
$reg_EN->grid(-row=>3,-column=>0,-columnspan=>3,-sticky=>'we');
$case_CB->grid(-row=>3,-column=>3);
$regexp_BT->grid(-row=>4,-column=>0,-columnspan=>2,-sticky=>'we');
$CLEARALL_BT->grid(-row=>4,-column=>2,-columnspan=>2,-sticky=>'we');
$loc_lab->grid(-row=>5,-column=>0,-columnspan=>4);
$MW->bind('all',"<Key-F1>"=>sub{toggle(0)});
$MW->bind('all',"<Key-F2>"=>sub{toggle(1)});
$MW->bind('all',"<Key-F3>"=>sub{toggle(2)});
$MW->bind('all',"<Control-Q>"=>sub{exit});
my %TXT_Note;
$TXT_Note{toplevel} = $MW->Toplevel(-title=>"N O T E"); $TXT_Note{toplevel}->state('withdrawn');
$TXT_Note{text} = $TXT_Note{toplevel}->Text(-wrap=>'word')->pack();
$TXT_Note{text}->configure(-font=>'courier 12',-width=>50,-height=>10,-foreground=>'#ffff00',-background=>'#888888');
$TXT_Note{done} = $TXT_Note{toplevel}->Button(-text=>'done',-font=>'courier-14',-command=>sub{notecreate()})->pack();
$TXT_Note{text}->bind("<Control-c>"=>sub{$TXT_Note{toplevel}->withdraw});
$TXT_Note{done}->configure(-background=>'#360C7A',-foreground=>'#eefa3f');
my $popM = $TXT_Note{toplevel} -> Menu(-tearoff=>0,-menuitems=>
[ [Button=>"copy", -command=>sub{$TXT_Note{text}->clipboardCopy}],
[Button=>"cut", -command=>sub{$TXT_Note{text}->clipboardCut}],
[Button=>"paste", -command=>sub{$TXT_Note{text}->clipboardPaste}],
]);
$popM->configure(-background=>"#360C7A",-foreground=>"#EEFA3F");
$TXT_Note{text}->bind("<Button-3>"=>sub{$popM->Popup(-popover=>"cursor",-popanchor=>'nw')});
my (@VW, @NB, %pg, %txt, %txt_found, %VW_BT, @VW_EN, %tag_LB, %LBlist, %LBref, %LBray, %LBsubs, %LN_lab,
@VW_num, @VW_case, @RGXP, @VW_rgxp, @TextMenu, $poptab, %LBsw);
foreach (0..2) { my $wn=$_;
(my $title = $_)+=1;
$VW[$_] = $MW->Toplevel(-title=>"$title"); $VW[$_]->state('withdrawn');
$VW[$_]->bind("<Control-Page_Up>"=>sub{changetab("$wn","-")});
$VW[$_]->bind("<Control-Page_Down>"=>sub{changetab("$wn","+")});
}
$VW[0]->configure(-background=>'#BBFFBB',-foreground=>'#360C7A');
$VW[1]->configure(-background=>'#BBBBFF',-foreground=>'#000000');
$VW[2]->configure(-background=>'#F1CE07',-foreground=>'#0000AA');
my @instances=(0,0,0);
my $caselight="";
foreach (0..2) { my $num=$_;
my $bgcolor;
$VW[$_]->geometry($VWgeom);
if ($_==0) {$bgcolor="#bbffbb"}
if ($_==1) {$bgcolor="#bbbbff"}
if ($_==2) {$bgcolor="#f1ce07"}
my $BT1 = "clear-$_";
$VW_BT{$BT1} = $VW[$_]->Button(-text=>'clear',-font=>'courier-14',-command=>sub{cleartab($BT1)});
$VW_BT{$BT1}->configure(-background=>'#663CAA',-foreground=>'#eefa3f');
my $nextplace=int ($VWwidth/250);
$VW_BT{$BT1}->place(-x=>$nextplace,-y=>4,-width=>80);
my $BT2 = "all-$_";
$VW_BT{$BT2} = $VW[$_]->Button(-text=>'all',-font=>'courier-14',-command=>sub{clearall($BT2)});
$VW_BT{$BT2}->configure(-background=>'#663CAA',-foreground=>'#eefa3f');
$nextplace+=80;
$VW_BT{$BT2}->place(-x=>$nextplace,-y=>4,-width=>60);
my $BT6 = "tags-$_";
$VW_BT{$BT6} = $VW[$_]->Button(-text=>'tags',-font=>'courier-14',-command=>sub{cleartags($BT6)});
$VW_BT{$BT6}->configure(-background=>'#663CAA',-foreground=>'#eefa3f');
$nextplace+=60;
$VW_BT{$BT6}->place(-x=>$nextplace,-y=>4);
$VW_num[$_] = $VW[$_]->Label(-textvariable=>\$instances[$_],-font=>'helvetica 24 bold',-foreground=>'#000000',-background=>"$bgcolor");
$nextplace=int ($VWwidth/4.9);
$VW_num[$_]->place(-x=>$nextplace,-y=>-10,-width=>100);
$VW_case[$_] = $VW[$_]->Label(-textvariable=>\$caselight,-font=>'helvetica 24 bold',-foreground=>'#cc0000',-background=>"$bgcolor");
$nextplace+=100;
$VW_case[$_]->place(-x=>$nextplace,-y=>-10,-width=>15);
my $BT5 = "unlite-$_";
$VW_BT{$BT5} = $VW[$_]->Button(-text=>'unlite',-font=>'courier-14',-command=>sub{tkhistory(\$VW_EN[$num],"add",$TEhist);
unlite($BT5)});
$VW_BT{$BT5}->configure(-background=>'#764Cdf',-foreground=>'#eefa3f');
$nextplace+=15;
$VW_BT{$BT5}->place(-x=>$nextplace,-y=>4,-width=>100);
$VW_EN[$_] = $VW[$_]->Entry(-font=>'helvetica 12 italic');
$nextplace+=101;
$VW_EN[$_]->place(-x=>$nextplace,-y=>4,-width=>200);
tkhistory(\$VW_EN[$_],"join",$TEhist);
$VW_EN[$_]->bind("<Key-Up>"=>sub{tkhistory(\$VW_EN[$num],"up", $TEhist)});
$VW_EN[$_]->bind("<Key-Down>"=>sub{tkhistory(\$VW_EN[$num],"down", $TEhist)});
$VW_EN[$_]->bind("<Key-Return>"=>sub{gotoLN($num)});
my $BT4 = "hilite-$_";
$VW_BT{$BT4} = $VW[$_]->Button(-text=>'hilite',-font=>'courier-14',-command=>sub{tkhistory(\$VW_EN[$num],"add",$TEhist);
hilite_BT($BT4)});
$VW_BT{$BT4}->configure(-background=>'#764Cdf',-foreground=>'#eefa3f');
$nextplace+=201;
$VW_BT{$BT4}->place(-x=>$nextplace,-y=>4,-width=>100);
$RGXP[$_] = "no";
$VW_rgxp[$_] = $VW[$_] -> Checkbutton(-text=>'regexp',-variable=>\$RGXP[$num],-onvalue=>"yes",-offvalue=>"no",-font=>"courier-10",-background=>"$bgcolor",-relief=>'solid');
$nextplace+=101;
$VW_rgxp[$_]->place(-x=>$nextplace,-y=>4);
my $BT3 = "first-$_";
$VW_BT{$BT3} = $VW[$_]->Button(-text=>'1st 4',-font=>'courier-14',-command=>sub{onefour($BT3)});
$VW_BT{$BT3}->configure(-background=>'#663CAA',-foreground=>'#eefa3f');
$nextplace=int ($VWwidth/1.3);
$VW_BT{$BT3}->place(-x=>$nextplace,-y=>4,-width=>'81');
my $BT7 = "save-$_";
$VW_BT{$BT7} = $VW[$_]->Button(-text=>'save',-font=>'courier-14',-command=>sub{messagable(\&savetags, "$num", "$BT7")});
$VW_BT{$BT7}->configure(-background=>'#663CAA',-foreground=>'#eefa3f');
$nextplace+=81;
$VW_BT{$BT7}->place(-x=>$nextplace,-y=>4,-width=>'75');
my $BT8 = "load-$_";
$VW_BT{$BT8} = $VW[$_]->Button(-text=>'load',-font=>'courier-14',-command=>sub{messagable(\&loadtags, "$num", "$BT8")});
$VW_BT{$BT8}->configure(-background=>'#663CAA',-foreground=>'#eefa3f');
$nextplace+=75;
$VW_BT{$BT8}->place(-x=>$nextplace,-y=>4,-width=>'75');
$VW[$_]->bind("<Control-f>"=>sub{messagable(\&findall, $num, "get", 'green')});
$VW[$_]->bind("<Control-g>"=>sub{goback($num)});
$VW[$_]->bind("<Control-h>"=>sub{quickref($num)});
$VW[$_]->bind("<Control-o>"=>sub{scroll($num,-1,"LB")});
$VW[$_]->bind("<Control-l>"=>sub{scroll($num,1,"LB")});
$VW[$_]->bind("<Control-i>"=>sub{scroll($num,-1,"TV")});
$VW[$_]->bind("<Control-k>"=>sub{scroll($num,1,"TV")});
$VW[$_]->bind("<Control-R>"=>sub{messagable(\&findall, $num, "get", 'red')});
$VW[$_]->bind("<Control-U>"=>sub{undored($num)});
$VW[$_]->bind("<Control-z>"=>sub{switchlist($num)});
$VW[$_]->bind("<Control-x>"=>sub{redswitch($num)});
$NB[$_] = $VW[$_]->NoteBook();
$NB[$_]->configure(-background=>'#360C7A',-foreground=>'#EEFA3F');
if ($_ == 0) {$NB[$_]->configure(-backpagecolor=>'#BBFFBB')}
elsif ($_ == 1) {$NB[$_]->configure(-backpagecolor=>'#BBBBFF')}
elsif ($_ == 2) {$NB[$_]->configure(-backpagecolor=>'#F1CE07')}
$NB[$_]->place(-x=>2,-y=>52);
foreach my $L ("A","B","C","D") { my $tab = "$L-$num";
$LBsw{$tab}=0;
$pg{$tab} = $NB[$num]->add($tab,-label=>'E M P T Y',-raisecmd=>sub{tabup($tab)});
$txt{$tab} = $pg{$tab}->ROText(-wrap=>'none');
@{$txt_found{$tab}}= ();
@{$LBlist{$tab}} = (); @{$LBray{$tab}} = (); @{$LBsubs{$tab}} = ();
$LBref{$tab}=\@{$LBray{$tab}};
$tag_LB{$tab} = $pg{$tab}->Listbox(-listvariable=>$LBref{$tab},-height=>int(($VWheight-52)/31.72),-width=>20,-font=>'helvetica 12 italic',-foreground=>'#88bb88',-background=>'#000000',
-selectbackground=>'#ffff00',-selectforeground=>'#693FAC',-selectmode=>'extended');
$LN_lab{$tab} = $pg{$tab}->Label(-font=>'helvetica 14 bold',-foreground=>'#cc0000');
if ($num eq 0) {$pg{$tab}->configure(-background=>'#99cc99',-foreground=>'#360c7a')}
if ($num eq 0) {$LN_lab{$tab}->configure(-background=>'#99cc99')}
if ($num eq 1) {$pg{$tab}->configure(-background=>'#8888aa',-foreground=>'#000000')}
if ($num eq 1) {$LN_lab{$tab}->configure(-background=>'#8888aa')}
if ($num eq 2) {$pg{$tab}->configure(-background=>'#c1ae00',-foreground=>'0000aa')}
if ($num eq 2) {$LN_lab{$tab}->configure(-background=>'#c1ae00')}
$txt{$tab}->grid(-row=>0,-rowspan=>2,-column=>0);
$tag_LB{$tab}->grid(-row=>0,-column=>1);
$LN_lab{$tab}->grid(-row=>1,-column=>1);
}
$TextMenu[$_] = $VW[$_] -> Menu(-tearoff=>0,-menuitems=>
[
[Button=>"B set bookmark", -command=>sub{txtbmk($poptab,"place")}],
[Button=>"b go to bookmark", -command=>sub{txtbmk($poptab,"goto")}],
[Button=>"g go to last position", -command=>sub{messagable(\&findall, $num, $poptab, 'green')}],
[Button=>"c character position", -command=>sub{charpos($poptab)}],
[Button=>"f green findall", -command=>sub{messagable(\&findall, $num, $poptab, 'green')}],
[Button=>"n next green find", -command=>sub{greenfind($poptab,"next")}],
[Button=>"p previous green find", -command=>sub{greenfind($poptab,"prev")}],
[Button=>"R red findall", -command=>sub{messagable(\&findall, $num, $poptab, 'red')}],
[Button=>"U undo red findall", -command=>sub{undored($num)}],
[Button=>"x (un)index red finds", -command=>sub{redswitch($num)}],
[Button=>"r mark selection red", -command=>sub{tagred($poptab)}],
[Button=>"N add note for selection", -command=>sub{marknote($poptab)}],
[Button=>"a add to line count", -command=>sub{messagable(\&numbering, $num, $poptab, '+')}],
[Button=>"s subtract from line count", -command=>sub{messagable(\&numbering, $num, $poptab, '-')}],
[Button=>"v send line to vim", -command=>sub{tovim($poptab)}],
[Button=>"z switch index", -command=>sub{switchlist($num)}],
[Button=>"Q quit", -command=>sub{exit}],
]);
$TextMenu[$_]->configure(-background=>"#360C7A",-foreground=>"#EEFA3F",-font=>'courier 12');
}
$NB[0]->configure(-background=>'#88bb88',-foreground=>'#360C7A');
$NB[1]->configure(-background=>'#8888aa',-foreground=>'#000000');
$NB[2]->configure(-background=>'#b19e00',-foreground=>'#0000AA');
foreach (keys %txt) { my $tab="$_";
(my $wn=$tab) =~ s/^[A-D]-//;
$txt{$_}->configure(-font=>'courier 12',-width=>int(($VWwidth-200)/10),-height=>int(($VWheight-52)/20.5),-foreground=>'black',-background=>'white');
$txt{$_}->tagConfigure('hlite',-foreground=>'#ff00FF',-background=>'#ffdd22',-font=>'courier 12 bold');
$txt{$_}->tagConfigure('bold',-foreground=>'#0000FF',-font=>'courier 12 italic');
$txt{$_}->tagConfigure('red',-foreground=>'#cc0000',-font=>'courier 12 bold');
$txt{$_}->tagConfigure('green',-foreground=>'#00cc00',-font=>'courier 12 bold');
$txt{$_}->tagConfigure('marked',-foreground=>'#ffff00',-background=>'#888888',-font=>'courier 12 italic');
$txt{$_}->tagConfigure('subfunc',-foreground=>'#ffff00',-background=>'#aa00aa',-font=>'courier 12 bold');
$txt{$_}->tagConfigure('QRbold',-font=>'courier 12 bold');
$txt{$_}->tagConfigure('QRitalic',-font=>'courier 12 italic');
$txt{$_}->tagBind('marked', "<Double-Button-1>", sub{displaynote($tab)});
$txt{$_}->tagBind('marked', "<Any-Enter>", sub{ $txt{$tab}->configure(-cursor=>'hand2')});
$txt{$_}->tagBind('marked', "<Any-Leave>", sub{ $txt{$tab}->configure(-cursor=>'xterm')});
$txt{$_}->menu(undef);
$txt{$tab}->bind("<Button-3>"=>sub{$poptab=$tab;$TextMenu[$wn]->Popup(-popover=>"cursor",-popanchor=>'nw')});
$tag_LB{$_}->bind("<Button-3>"=>sub{gototag($tab)});
$tag_LB{$_}->bind("<Button-2>"=>sub{removetag($tab)});
$txt{$_}->bind("<Button-1>"=>sub{linenumber($tab)});
$txt{$_}->bind("<Key-Page_Up>"=>sub{linenumber($tab)});
$txt{$_}->bind("<Key-Page_Down>"=>sub{linenumber($tab)});
$txt{$_}->bind("<Key-Up>"=>sub{linenumber($tab)});
$txt{$_}->bind("<Key-Down>"=>sub{linenumber($tab)});
$txt{$_}->bind("<Control-a>"=>sub{messagable(\&numbering, $wn, $tab, '+')});
$txt{$_}->bind("<Control-b>"=>sub{txtbmk($tab,"goto")});
$txt{$_}->bind("<Control-B>"=>sub{txtbmk($tab,"place")});
$txt{$_}->bind("<Control-c>"=>sub{charpos($tab)});
$txt{$_}->bind("<Control-N>"=>sub{marknote($tab)});
$txt{$_}->bind("<Control-n>"=>sub{greenfind($tab,"next")});
$txt{$_}->bind("<Control-p>"=>sub{greenfind($tab,"prev")});
$txt{$_}->bind("<Control-r>"=>sub{tagred($tab)});
$txt{$_}->bind("<Control-s>"=>sub{messagable(\&numbering, $wn, $tab, '-')});
$txt{$_}->bind("<Control-u>"=>sub{$txt{$tab}->tagRemove('red', 'sel.first', 'sel.last')});
$txt{$_}->bind("<Control-v>"=>sub{tovim($tab)});
$txt{$_}->tagRaise('marked');
$txt{$_}->tagRaise('hlite', 'bold');
$txt{$_}->tagRaise('red', 'hlite');
}
my (@swapray, $notetab, %notehash, @bookmarks);
my @c_pos=(1,0);
my $where="1.0";
my $bmark="1.0";
my $redsw=0;
if (defined $ARGV[1]){$suf_EN->insert('1.0', "$ARGV[1]")}
if (defined @ARGV){$dir_EN->insert('1.0', "$ARGV[0]");fillbox();}
if (defined $ARGV[2]){$reg_EN->insert('1.0', "$ARGV[2]");trimbox();}
my $bmcount=0; bookmarks('load');
@{$info{'A-0'}}=("1");
@{$info{'A-1'}}=("2");
@{$info{'A-2'}}=("3");
MainLoop;
sub addto { my $wn = "@_";
my $name=$DLB->get('active');
foreach my $X ("A", "B", "C", "D") {
my $tab="$X-$wn";
my $content = $txt{$tab}->Contents();
if ($content =~ /\w/) {next}
else { $name =~ s/^\*+//;
$name =~ s/\s\(\d+\)$//;
messagable(\&dofile, $wn, $name, $tab);
last}
}
showloc();
}
sub bookmarks { my $do=$_[0];
if ($do eq 'load') {
open (BM, "<$bmfile") || return;
while (<BM>) {chomp $_; push @bookmarks, $_};
close (BM);
}
if ($do eq 'add') {
my $entry=$dir_EN->get();
unless (defined($entry) && $entry =~ /\w/) {return "nothing to add!"}
foreach (@bookmarks) {if ($_ eq $entry) {return "bookmark exists"}}
push @bookmarks, $entry;
sysopen (BM, "$bmfile", O_WRONLY | O_APPEND | O_CREAT) || return "no bookmark file!";
print BM "$entry\n";
close (BM);
return "+$entry";
}
if ($do eq 'subtract') {
my $entry=$dir_EN->get();
my @new = grep { $_ ne "$entry"} @bookmarks;
@bookmarks = @new;
open (BM, ">$bmfile") || return "no bookmark file!";
foreach (@bookmarks) {print BM "$_\n"};
close (BM);
$dir_EN->delete('0','end');
$bmcount=0;
return "-$entry";
}
if ($do eq 'move') { my $adj=$_[1];
(my $tmp=$bmcount)+=$adj;
if (defined($bookmarks[$tmp])) {$bmcount=$tmp;
$dir_EN->delete('0','end');
$dir_EN->insert('1',$bookmarks[$bmcount]);
} else {$bmcount=0}
}
}
sub caselight {
if ($case eq "nocase") {$caselight=""}
elsif ($case eq "case") {$caselight="*"}
}
sub changetab { my $wn = $_[0];
my $tab=$NB[$wn]->raised();
(my $AD = $tab)=~s/-[0-3]$//;
my $ai=ord($AD);
if ($_[1] eq "-") {
if ($ai == 65) {$ai=68}
else {$ai--};
}
if ($_[1] eq "+") {
if ($ai == 68) {$ai=65}
else {$ai++};
}
$ai=chr($ai);
(my $new = $ai)=~s/$/-$wn/;
$NB[$wn]->raise($new);
}
sub charpos {
my $charpos = $txt{$_[0]}->index('insert');
$LN_lab{$_[0]}->configure(-text=>"$charpos");
}
sub clearall { (my $num=$_[0])=~s/all-//;
$instances[$num]=0;
(my $title=$num)+=1;
foreach ("A","B","C","D") {
my $tab="$_-$num";
$txt{$tab}->delete('1.0','end');
$#{$LBlist{$tab}}=-1;
$#{$LBray{$tab}}=-1;
$#{$LBsubs{$tab}}=-1;
$tag_LB{$tab}->delete('0','end');
$NB[$num]->pageconfigure($tab,-label=>"E M P T Y");
if (defined($info{$tab}[1])) {
unless ($info{$tab}[1] eq "Quick Reference") {
$loc{$info{$tab}[1]}=~s/\s?$tab//;
$loc{$info{$tab}[1]}=~s/^\s//;
if ($loc{$info{$tab}[1]} !~ /\d/) {delete $loc{$info{$tab}[1]}}
my $i=0;
foreach (@dirray) {
if ($_ =~ /\*+$info{$tab}[1]/) {
$_ =~ s/^\*//;
$DLB->activate($i);
}
$i++;
} }
}
@{$info{$tab}}=("$title");
}
$VW[$num]->title("$title");
showloc();
}
sub cleartab { (my $num=$_[0])=~s/clear-//;
$instances[$num]=0;
my $clear = $NB[$num]->raised();
if ($LBsw{$clear}==1) {switchlist($num)}
$txt{$clear}->delete('1.0','end');
$#{$LBlist{$clear}}=-1;
$#{$LBray{$clear}}=-1;
$#{$LBsubs{$clear}}=-1;
$tag_LB{$clear}->delete('0','end');
$NB[$num]->pageconfigure($clear,-label=>"E M P T Y");
if (defined($loc{$info{$clear}[1]})) {
$loc{$info{$clear}[1]}=~s/\s?$clear//;
$loc{$info{$clear}[1]}=~s/^\s//;
my $i;
foreach (@dirray) {
if ($_ =~ /\*+$info{$clear}[1]/) {
$_ =~ s/^\*//;
$DLB->activate($i);
}
$i++}
if ($loc{$info{$clear}[1]} !~ /\d/) {delete $loc{$info{$clear}[1]}}
}
(my $x=$num)+=1;
@{$info{$clear}}=("$x"); (my $title = $num)+=1;
$VW[$num]->title("$title");
$DLB->activate('active');
showloc();
}
sub cleartags { (my $wn=$_[0])=~s/tags-//;
$instances[$wn]=0;
my $tab = $NB[$wn]->raised();
if ($LBsw{$tab}==1) {switchlist($wn)}
$txt{$tab}->tagRemove('hlite', '1.0', 'end');
$txt{$tab}->tagRemove('bold', '1.0', 'end');
$txt{$tab}->tagRemove('red', '1.0', 'end');
$txt{$tab}->tagRemove('marked', '1.0', 'end');
$#{$LBlist{$tab}}=-1;
$#{$LBray{$tab}}=-1;
}
sub displaynote { my $tab="@_"; (my $wn=$tab)=~s/^[A-D]-//;
my $pos = $c_pos[1]+1;
$pos = "$c_pos[0].$pos";
my @range=$txt{$tab}->tagPrevrange('marked', $pos);
my @line = split /\./,$range[0];
my $ray=\@{$LBlist{$tab}};
for (my $i=0;$i<scalar @$ray; $i++) {
if ($$ray[$i]{line}==$line[0] && $$ray[$i]{type} eq "hyper" && $$ray[$i]{start}==$range[0] && $$ray[$i]{end}==$range[1]) {
$notehash{line} = $$ray[$i]{line};
$notehash{start} = $$ray[$i]{start};
$notehash{end} = $$ray[$i]{end};
$notehash{type} = $$ray[$i]{type};
$notehash{content} = $$ray[$i]{content};
$notehash{note} = $$ray[$i]{note};
last;}
if ($i==(scalar @$ray)-1) {print "displaynote(): error\n";return}
}
$notetab=$tab;
$TXT_Note{toplevel}->state('normal');
$TXT_Note{text}->Insert("$notehash{note}");
$TXT_Note{text}->GotoLineNumber('1');
$TXT_Note{toplevel}->title("${$info{$notetab}}[1]: line $notehash{line}");
}
sub dofile { (my $name = $_[0]) =~ s/^\*+//; my $tab = $_[1];
open (FH, "$files{$name}") || return "Can't open $files{$name}";
while (<FH>) {$txt{$tab}->Insert("$_")}
close (FH);
my $i=0;
foreach (@dirray) {
if ($_ =~ m/^\**$name(\s\(\d+\))?$/) {
$_ =~ s/^/\*/;
$DLB->activate($i)}
$i++;
}
(my $wn = $tab) =~ s/^[A-D]-//; (my $le = $tab) =~ s/-[0-3]$//;
(my $title = $wn)+=1;
$NB[$wn]->pageconfigure($tab,-label=>"$name");
@{$info{$tab}}=("$title$le:", "$name");
$VW[$wn]->title("@{$info{$tab}}");
if (exists($loc{$name})) {$loc{$name}="$loc{$name} $tab"}
else {$loc{$name}=$tab}
unless ($regexp eq "") {hilite("$tab", "$regexp", "def")}
$txt{$tab}->GotoLineNumber(1);
$NB[$wn]->raise($tab);
if ($LBsw{$tab}==1) {switchlist($wn)}
litesubs($tab);
}
sub fillbox {
my @sfx = split /, /,$suf_EN->get() || return "No suffix!";
%files=();
my $dir=$dir_EN->get();
my %options=("wanted"=>\&getfiles,"follow"=>1);
if ($slink==0) {$options{follow}=0};
find(\%options,$dir);
@dirray = sort (@swapray);
@swapray = ();
my $n=0;
foreach my $file (@dirray) {
if (exists($loc{$file}) && $loc{$file} =~ /-/) {
$_ = "$loc{$file}";
my $x =()= /-/g;
my $i=0;
until ($i==$x) {
$file =~ s/^/\*/;
$DLB->activate($n);
$i++}
}
$n++}
$MW->title("TkCodex");
}
sub findall { (my $wn = $_[0])=~s/^[A-D]-//; my $tab=$NB[$wn]->raised(); my $rgb=$_[1];
tkhistory(\$VW_EN[$wn], "add", $TEhist);
$instances[$wn]=0;
$txt{$tab}->tagRemove('green', '1.0', 'end');
my $exact = $VW_EN[$wn]->get();
unless ($exact =~ /\w/) {return "No search criteria!"}
if ($case eq "nocase" && $RGXP[$wn] eq "no") {$txt{$tab}->FindAll(-exact, -nocase, "$exact")}
elsif ($case eq "case"&& $RGXP[$wn] eq "no") {$txt{$tab}->FindAll(-exact, -case, "$exact")}
elsif ($case eq "nocase"&& $RGXP[$wn] eq "yes") {$txt{$tab}->FindAll(-regexp, -nocase, "$exact")}
elsif ($case eq "case"&& $RGXP[$wn] eq "yes") {$txt{$tab}->FindAll(-regexp, -case, "$exact")}
my @found=$txt{$tab}->tagRanges('sel');
my $i=-1;
while (defined($found[0])) {
my $begin = shift @found;
my $end = shift @found;
if ($rgb eq "green") {${$txt_found{$tab}}[++$i]=$begin}
elsif ($rgb eq "red") {my $ray=\@{$LBlist{$tab}};
my $num = scalar @$ray;
my @start = split /\./,$begin;
$$ray[$num]{line}=$start[0];
$$ray[$num]{start}=$begin;
$$ray[$num]{end}=$end;
$$ray[$num]{content}=$exact;
$$ray[$num]{type}="red"}
$txt{$tab}->tagAdd("$rgb", "$begin", "$end");
$instances[$wn]++;
}
$VW[$wn]->title("@{$info{$tab}} ($exact) $rgb-lit");
if ($rgb eq "red") { $redsw=0;
redswitch($wn)}
}
sub formlist { my $tab=$_[0]; (my $wn=$tab)=~s/^[A-D]-//;
$#{$LBray{$tab}}=-1;
my $ray=\@{$LBlist{$tab}};
my $num=scalar @$ray;
if ($num>1) {@$ray=sort{$a->{line} <=> $b->{line}}@$ray}
my $n=0;
for (my $i=0;$i<$num;$i++) {
my $hash = \%{$$ray[$i]};
if ($redsw==0 && ${$hash}{type} eq "red") {next}
my $line=${$hash}{line}; my $content=${$hash}{content};
if (${$hash}{type} eq "SUB") { ${$LBray{$tab}}[$n]=$content }
elsif (${$hash}{type} =~ /UC/) { ${$LBray{$tab}}[$n]="*$line: $content" }
else { ${$LBray{$tab}}[$n]="$line: $content" }
if (${$hash}{type} eq "hyper") {$tag_LB{$tab}->itemconfigure($n,-foreground=>'#ff00ff')}
elsif (${$hash}{type} =~ /RX/) {$tag_LB{$tab}->itemconfigure($n,-foreground=>'#ffffff')}
elsif (${$hash}{type} eq "red" && $redsw==1) {$tag_LB{$tab}->itemconfigure($n,-foreground=>'#ff0000')}
$n++;
}
}
sub getfiles { my $file=\$_;
my @sfx = split /,/,$suf_EN->get() || return;
unless (-d) {foreach my $end (@sfx) {
if ($$file =~ /\.$end$/) {
my $tmp = $File::Find::name;
if (exists($files{$$file})) {
my $dir=$dir_EN->get();
($$file=$tmp)=~s/^\/?$dir\/?//;
}
push @swapray, $$file;
$files{$$file} = $tmp;
last}
}}
}
sub greenfind { my $tab=shift; my $way=shift;
my @start;
if ($way eq "next") {
foreach (@{$txt_found{$tab}}) {
@start=split /\./,$_;
if (($start[0]==$c_pos[0]) && ($start[1] > $c_pos[1]) || ($start[0] > $c_pos[0])) {
$txt{$tab}->SetCursor($_);
linenumber($tab);return}
}
} else {
for (my $i=$#{$txt_found{$tab}};$i>=0;$i--) {
@start=split /\./,${$txt_found{$tab}}[$i];
if (($start[0]==$c_pos[0]) && ($start[1] < $c_pos[1]) || ($start[0] < $c_pos[0])) {
$txt{$tab}->SetCursor(${$txt_found{$tab}}[$i]);
linenumber($tab);return}
}
}
$txt{$tab}->SetCursor("$c_pos[0].$c_pos[1]");
}
sub goback { my $wn="@_";
my $tab=$NB[$wn]->raised();
$txt{$tab}->SetCursor($where);
$where = "$c_pos[0].$c_pos[1]";
linenumber($tab);
}
sub gotoLN { my $wn=shift;
my $tab=$NB[$wn]->raised();
my $place=$c_pos[0];
my $LN = $VW_EN[$wn]->get();
if ($LN !~ /^\d+$/) {$VW[$wn]->title("$LN is not a line number."); return}
$txt{$tab}->GotoLineNumber("$LN");
linenumber($tab);
$VW_EN[$wn]->delete('0','end');
$VW_EN[$wn]->insert('1', $place);
}
sub gototag { my $tab="@_";
$where = "$c_pos[0].$c_pos[1]";
my $goto;
if ($LBsw{$tab}==0) {
my $index=$tag_LB{$tab}->get('active');
$index=~/^\*?(\d+):/;
$goto=$1;
} else {
my $I=$tag_LB{$tab}->index('active');
$goto=${$LBlist{$tab}}[$I]{line};
}
$txt{$tab}->yview($goto-1);
$txt{$tab}->SetCursor("$goto.0");
linenumber($tab);
}
sub hilite_BT { (my $n=$_[0])=~s/hilite-//;
my $exact = $VW_EN[$n]->get();
if ($exact eq "") {return}
$VW_EN[$n]->delete('0','end');
my $tab = $NB[$n]->raised();
hilite("$tab", "$exact");
}
sub hilite { my $tab="$_[0]"; my $expre = "$_[1]"; (my $wn = $tab)=~s/^[A-D]-//;
my $chars=0; my @start=("1","0");
$instances[$wn] = 0; my $type;
if ((defined($_[2]) || $RGXP[$wn] eq "yes") && $case eq "nocase") {$type="RX"}
elsif ((defined($_[2]) || $RGXP[$wn] eq "yes") && $case eq "case") {$type="RXUC"}
elsif ($case eq "nocase") {$type="NORM"}
elsif ($case eq "case") {$type="UC"}
if ($LBsw{$tab}==1) {switchlist($wn)}
while (1) { my $x;
if ($type eq "RX") {$x = $txt{$tab}->search(-regexp,-nocase,-count=>$chars,"$expre","$start[0].$start[1]", 'end')}
elsif ($type eq "RXUC") {$x = $txt{$tab}->search(-regexp,-count=>$chars,"$expre","$start[0].$start[1]", 'end')}
elsif ($type eq "NORM") {$x = $txt{$tab}->search(-exact,-nocase,-count=>$chars,"$expre","$start[0].$start[1]", 'end')}
elsif ($type eq "UC") {$x = $txt{$tab}->search(-exact,-count=>$chars,"$expre","$start[0].$start[1]", 'end')}
unless (defined($x) && $x =~ /^\d+\.\d+$/) {last}
my @index = split /\./,$x;
if ($index[0] < $start[0]) {last}
if ($index[0] == $start[0] && $index[1] < $start[1]) {last}
$instances[$wn]++;
(my $y = $index[1])+=$chars;
pushtag($tab, $index[0], $x, "$index[0].$y", $expre, $type);
@start=("$index[0]","$y");
}
formlist($tab);
markup($tab);
}
sub linenumber { my $tab="@_"; (my $wn=$tab)=~s/^[A-D]-//;
$VW[$wn]->title("@{$info{$tab}}");
$where="$c_pos[0].$c_pos[1]";
@c_pos=split /\./,$txt{$tab}->index('insert');
$LN_lab{$tab}->configure(-text=>"line $c_pos[0]");
}
sub litesubs { my $tab=shift;
${$info{$tab}}[1]=~/\.(\w+)$/;
my $flav=$1;
my $match=" ";
foreach my $type (keys %subrxp) {
my @tray=split /,/,$type;
foreach (@tray) {
if ($_ eq $flav) {$match=$subrxp{$type};last;} }
}
unless ($match =~ /\w+/) {return}
my $ray=\@{$LBsubs{$tab}};
my $text=$txt{$tab}->Contents();
my @contents=split /\n/,$text;
foreach (my $i=0;$i<@contents;$i++) {
if ($contents[$i] =~ /$match/) {
my $new=scalar @$ray; my $I=$i+1;
${$$ray[$new]}{line}=$I;
my $len1 = length $1; my $len2 = $len1 + length $2;
${$$ray[$new]}{start}="$I.$len1";
${$$ray[$new]}{end}="$I.$len2";
${$$ray[$new]}{content}=$2;
${$$ray[$new]}{type}="SUB";
}
}
}
sub loadtags { (my $wn="$_[0]") =~ s/load-//;
my $tab=$NB[$wn]->raised();
if ($LBsw{$tab}==1) {switchlist($wn)}
$instances[$wn]=0;
(my $name="@{$info{$tab}}[1]") =~ s/\//_/;
my $file="$CXdir/$name.store";
if (!(-o $file)) {return "No tagfile for $name"}
my $rayref = retrieve($file);
$VW[$wn]->title("loading tags for $name from $CXdir");
my @ray = @{$rayref};
my @listray = @{$LBlist{$tab}};
for (my $i=0;$i<=$#ray;$i++) {
my $sw=0;
for (my $I=0;$I<=$#listray;$I++) {
if (${$ray[$i]}{content} eq ${$listray[$I]}{content}) {
if (${$ray[$i]}{type} eq ${$listray[$I]}{type}) {
if (${$ray[$i]}{line} == ${$listray[$I]}{line}) {
if (${$ray[$i]}{start} eq ${$listray[$I]}{start}) {$sw=1}
} } } }
if ($sw==0) {push @{$LBlist{$tab}}, $ray[$i]}
}
formlist($tab);
markup($tab);
}
sub marknote { my $tab="@_";
$txt{$tab}->index('sel.first')=~/^(\d+)\.(\d+)$/;
my $start="$1.$2"; my $line=$1;
my $end=$txt{$tab}->index('sel.last');
$txt{$tab}->tagAdd('marked', "$start", "$end");
my $content=$txt{$tab}->get($start, $end);
%notehash = ("line"=>$line, "start"=>$start, "end"=>$end, "content"=>$content);
$TXT_Note{toplevel}->state('normal');
$TXT_Note{toplevel}->title("${$info{$tab}}[1]: line $line");
$notetab=$tab;
}
sub markup { my $tab=shift;
$txt{$tab}->tagRemove('hlite', '1.0', 'end');
$txt{$tab}->tagRemove('bold', '1.0', 'end');
$txt{$tab}->tagRemove('marked', '1.0', 'end');
$txt{$tab}->tagRemove('subfunc', '1.0', 'end');
my @listray=@{$LBlist{$tab}};
foreach (my $i=0; $i<=$#listray; $i++) {
my $start=${$listray[$i]}{start};
my $end=${$listray[$i]}{end};
my $line=${$listray[$i]}{line};
if (${$listray[$i]}{type} eq "hyper") {$txt{$tab}->tagAdd('marked', $start, $end)}
elsif (${$listray[$i]}{type} eq "SUB") {
$txt{$tab}->tagAdd('subfunc', $start, $end)}
elsif (${$listray[$i]}{type} eq "red") {$txt{$tab}->tagAdd('red',$start,$end)}
else {$txt{$tab}->tagAdd('hlite', $start, $end);
$txt{$tab}->tagAdd('bold', "$line.0", "$line.0 lineend");}
}
}
sub messagable { my $func= shift @_; my $wn = shift @_; my $tab = shift;
if ($tab eq "get") {$tab=$NB[$wn]->raised()}
my $message=$func->($tab,@_); unless (defined($message)) {return}
if ($message =~ /[A-Z]+|[a-z]+/) {
$VW[$wn]->title($message)}
}
sub messagemain { my $func= shift @_;
my $message=$func->(@_); unless (defined($message)) {return}
if ($message =~ /[A-Z]+|[a-z]+/) {
$MW->title($message)}
}
sub notecreate {
my $note=$TXT_Note{text}->Contents();
$TXT_Note{text}->delete('1.0', 'end');
$TXT_Note{toplevel}->withdraw;
my $ray=\@{$LBlist{$notetab}};
my $new = scalar @$ray;
for (my $i=0;$i<$new;$i++) {
if ($$ray[$i]{line} == $notehash{line}) {
if ($$ray[$i]{type} eq "hyper") {
if ($$ray[$i]{content} eq $notehash{content}) {
if ($$ray[$i]{start} eq $notehash{start}) {
$$ray[$i]{note} = $note;
formlist($notetab);
return}
} } } }
$$ray[$new]{line}=$notehash{line};
$$ray[$new]{start}=$notehash{start};
$$ray[$new]{end}=$notehash{end};
$$ray[$new]{type}="hyper";
$$ray[$new]{content}=$notehash{content};
$$ray[$new]{note}=$note;
formlist($notetab);
}
sub numbering { my $tab=$_[0]; my $way=$_[1]; (my $wn=$tab)=~s/^[A-D]-//;
my $int = $VW_EN[$wn]->get(); if ($int =~ /^\d+$/) {$VW_EN[$wn]->delete('0', 'end')}
unless ($int =~ /^\d+$/) {$int=1}
if ($way eq "-") {$int=-$int}
(my $repos=$c_pos[0])+=$int;
if ($repos <= 0) {return "can't do that! (the number is too big)"}
my $ray=\@{$LBlist{$tab}};
for (my $i=0;$i<scalar @$ray;$i++) {
if ($$ray[$i]{line}>=$c_pos[0]) {
$$ray[$i]{line}+=$int;
my @start=split /\./,$$ray[$i]{start};
my @end=split /\./,$$ray[$i]{end};
$start[0]+=$int; $end[0]+=$int;
$$ray[$i]{start}="$start[0].$start[1]";
$$ray[$i]{end}="$end[0].$end[1]";
}
}
formlist($tab);
markup($tab);
}
sub onefour { (my $num=$_[0])=~s/first-//;
clearall("all-$num");
my @opentabs = ("A-$num", "B-$num", "C-$num", "D-$num");
foreach my $i (0..3) {
if ($i > $#dirray) {last};
(my $file = $dirray[$i]) =~ s/\s\(\d+\)$//;
messagable(\&dofile, $num, $file, $opentabs[$i])}
$NB[$num]->raise("A-$num");
}
sub pushtag { my $tab=shift; (my $wn=$tab) =~ s/^[A-D]-//;
my %hash;
$hash{line}=shift;
$hash{start}=shift;
$hash{end}=shift;
$hash{content}=shift;
$hash{type}=shift;
my @ray=@{$LBlist{$tab}};
for (my $i=0;$i<=$#ray;$i++) {
if (${$ray[$i]}{line} == $hash{line}) {
if (${$ray[$i]}{content} eq $hash{content}) {
if (${$ray[$i]}{type} eq $hash{type}) {
if (${$ray[$i]}{start} eq $hash{start}) {return}
} } } }
my $rayref=\@{$LBlist{$tab}};
my $num=scalar @$rayref;
${$$rayref[$num]}{line}=$hash{line};
${$$rayref[$num]}{start}=$hash{start};
${$$rayref[$num]}{end}=$hash{end};
${$$rayref[$num]}{type}=$hash{type};
${$$rayref[$num]}{content}=$hash{content};
if (${$$rayref[$num]}{type} eq "hyper") {${$$rayref[$num]}{note}=$hash{note}}
}
sub processbold { my $tab = $_[0];
my @index = split /(:.)/,$_[1],3;
$txt{$tab}->tagAdd('bold', "$index[0].0", "$index[0].0 lineend");
my $char; my $y=0;
if ($index[1] eq ":^") { my $count; my $x;
while (1) {
$x = $txt{$tab}->search(-exact,-count=>$count,"$index[2]","$index[0].$y", "$index[0].end");
unless (defined($x) && $x =~ /^\d+\.\d+$/) {last}
($y=$x)=~s/^\d+\.//;
$y+=$count;
$txt{$tab}->tagAdd('hlite', "$x", "$index[0].$y")}
} elsif ($index[1] eq ":!") { my $count; my $x;
while (1) {
$x = $txt{$tab}->search(-regexp,-count=>$count,"$index[2]","$index[0].$y", "$index[0].end");
unless (defined($x) && $x =~ /^\d+\.\d+$/) {last}
($y=$x)=~s/^\d+\.//;
$y+=$count;
$txt{$tab}->tagAdd('hlite', "$x", "$index[0].$y")}
} elsif ($index[1] eq ":~") { my $count; my $x;
while (1) {
$x = $txt{$tab}->search(-regexp,-nocase,-count=>$count,"$index[2]","$index[0].$y", "$index[0].end");
unless (defined($x) && $x =~ /^\d+\.\d+$/) {last}
($y=$x)=~s/^\d+\.//;
$y+=$count;
$txt{$tab}->tagAdd('hlite', "$x", "$index[0].$y")}
} elsif ($index[1] eq ": ") { my $count; my $x;
while (1) {
$x = $txt{$tab}->search(-exact,-nocase,-count=>$count,"$index[2]","$index[0].$y","$index[0].end");
unless (defined($x) && $x =~ /^\d+\.\d+$/) {last}
($y=$x)=~s/^\d+\.//;
$y+=$count;
$txt{$tab}->tagAdd('hlite', "$x", "$index[0].$y");
}
}
}
sub process_config { my $cfile=shift;
open (CFG, "<$cfile") || return;
print "\nTkCodex: using $cfile for configuration...\n";
while (<CFG>) {
chomp;
if ($_ =~ /^show/) {$show=1;next}
if ($_ =~ /^no follow/) {$slink=0;
print "\tFollow softlinks turned OFF\n";
next}
my @line = split /: /;
if ($line[0] eq "directory") {$CXdir=$line[1];
if ($show==1) {print "\tnote directory: \"$CXdir\"\n"}
next}
if ($line[0] eq "geometry") {$VWgeom=$line[1];
$line[1]=~/^(\d+)x(\d+)\+/;
$VWwidth=$1;
if ($VWwidth<1050) { $VWwidth=1050;
$VWgeom="1050x600+0+0";
$VWheight=600;}
else {$VWheight=$2}
if ($show==1) {print "\tgeometry: \"$VWgeom\"\n"}
next}
if ($line[0] eq "sub") {
my @ray = split /=/,$line[1];
my $type = shift @ray;
my @ray2 = split /,/,$ray[0];
foreach (@ray2) {
if ($_ eq 'c') {delete $subrxp{'c,h'}}
elsif ($_ eq 'h') {delete $subrxp{'c,h'}}
elsif ($_ eq 'pl') {delete $subrxp{'pl'}}
}
$subrxp{$type} = shift @ray;
if ($show==1) {print "\tsubroutine regexp for \"$type\": \"$subrxp{$type}\"\n"}
next}
if ($line[0] eq "bookmarks") {
$bmfile=$line[1];
if ($show==1) {print "\tbookmark file set to \"$bmfile\"\n"}
next}
}
}
sub redswitch { my $wn=shift;
my $tab=$NB[$wn]->raised();
if ($redsw==0) {$redsw++}
else {$redsw--}
if ($LBsw{$tab}==1) {switchlist($wn)}
formlist($tab);
markup($tab);
}
sub removetag { my $tab=$_[0];
if ($LBsw{$tab}==1) {return};
my $anchor = $tag_LB{$tab}->index('anchor');
my $end = $tag_LB{$tab}->index('active');
for (my $i=$anchor; $i<=$end; $i++) {
if (${$LBlist{$tab}}[$i]{type} eq "red") {
$txt{$tab}->tagRemove('red', ${$LBlist{$tab}}[$i]{start}, ${$LBlist{$tab}}[$i]{end});
}
${$LBlist{$tab}}[$i]="null";
}
@{$LBlist{$tab}} = grep {$_ ne 'null'} @{$LBlist{$tab}};
formlist($tab);
markup($tab);
}
sub savetags { (my $wn=$_[0])=~s/save-//;
my $tab=$NB[$wn]->raised();
if ($LBsw{$tab}==1) {switchlist($wn)}
unless (defined(${$LBray{$tab}}[0])) {return "nothing to save"}
(my $name="${$info{$tab}}[1]") =~ s/\//_/;
my $file="$CXdir/$name.store";
store(\@{$LBlist{$tab}}, $file) || return "Failed to save $file";
return "saved notes for $name";
}
sub scroll { my $wn=shift;
my $tab = $NB[$wn]->raised();
my $dir = shift;
if ($_[0] eq "LB") {$tag_LB{$tab}->yviewScroll($dir,'units')}
else {$txt{$tab}->yviewScroll($dir,'units')}
}
sub showloc { my $name=$DLB->get('anchor');
$loctxt="";
$name =~ s/^\**//;
$name =~ s/\s\(\d+\)$//;
if (exists($loc{$name})) {
$loctxt="";
my @locations = split / /,$loc{$name};
foreach (@locations) {
(my $N = $_) =~ s/^..//; $N++;
(my $l = $_) =~ s/..$//;
$loctxt="$loctxt $N$l";
}
}
}
sub switchlist { my $wn = shift;
my $tab = $NB[$wn]->raised();
my @tmp=@{$LBlist{$tab}};
@{$LBlist{$tab}}=@{$LBsubs{$tab}};
@{$LBsubs{$tab}}=@tmp;
if ($LBsw{$tab}==0) { $LBsw{$tab}=1;
$tag_LB{$tab}->configure(-background=>'#888888',-foreground=>'#ffff00',-font=>'helvetica 12');}
else { $LBsw{$tab}=0;
$tag_LB{$tab}->configure(-background=>'#000000',-foreground=>'#88bb88',-font=>'helvetica 12 italic');}
formlist($tab);
markup($tab);
}
sub tabup { my $tab = "@_";
(my $wn = $tab) =~ s/^[A-D]-//; (my $tn=$wn)+=1;
unless (exists($info{$tab})) { @{$info{$tab}}=("$tn") }
if (defined($wn)) {$VW[$wn]->title("@{$info{$tab}}")}
if ($LBsw{$tab}==1) {$tag_LB{$tab}->configure(-background=>'#888888',-foreground=>'#ffff00',-font=>'helvetica 12');}
else {$tag_LB{$tab}->configure(-background=>'#000000',-foreground=>'#88bb88',-font=>'helvetica 12 italic');}
}
sub tagred { my $tab=shift;
(my $wn = $tab) =~ s/^[A-D]-//;
if ($LBsw{$tab}==1) {switchlist($wn)}
$txt{$tab}->tagAdd('red','sel.first','sel.last');
my $first = $txt{$tab}->index('sel.first');
my $ray = \@{$LBlist{$tab}};
my $next = scalar @$ray;
$first =~ /(\d+)\./;
$$ray[$next]{line}=$1;
$$ray[$next]{start}=$first;
$$ray[$next]{end}=$txt{$tab}->index('sel.last');
$$ray[$next]{type}='red';
$$ray[$next]{content}=$txt{$tab}->get('sel.first','sel.last');
if ($redsw==0) {$redsw=1};
formlist($tab);
}
sub tkhistory {
my $entry = shift;
if ($entry == 0) {
my %hash;
my @list;
$hash{hlist} = \@list;
my $ref = \%hash;
return $ref;}
my $cmand = shift; my $hist;
if ($cmand eq "new") {
my %hash;
my @list;
$hash{hlist} = \@list;
$hash{$entry} = -1;
my $ref = \%hash;
return $ref;
} else {$hist = shift;}
if ($cmand eq "add") {
my $string = $$entry->get;
foreach my $elem (@{$hist->{hlist}}) {
if ($string eq $elem) {return 0}}
push(@{$hist->{hlist}},$string);
$hist->{$entry} == $#{$hist->{hlist}};
} elsif ($cmand eq "up") {
if ($#{$hist->{hlist}} == -1) {return}
if ($hist->{$entry} < 0) {$hist->{$entry} = $#{$hist->{hlist}}}
else {$hist->{$entry}--};
$$entry->delete('0','end');
$$entry->insert('1',$hist->{hlist}[$hist->{$entry}]);
} elsif ($cmand eq "down") {
$$entry->delete('0','end');
if ($#{$hist->{hlist}} == -1) {return}
if ($hist->{$entry} == $#{$hist->{hlist}}) {
$hist->{$entry} = -1;
return}
$hist->{$entry}++;
$$entry->insert('1',$hist->{hlist}[$hist->{$entry}]);
} elsif ($cmand eq "join") {
$hist->{$entry} = 0;
}
}
sub toggle { my $n = "@_";
my $state = $VW[$n]->state();
my $newstate = ($state eq 'withdrawn') ? 'normal' : 'withdrawn';
$VW[$n]->state("$newstate");
}
sub tovim { my $tab="@_"; (my $wn = $tab) =~ s/^[A-D]-//;
my $index=$txt{$tab}->index('insert');
(my $ln=$index)=~s/\.\d+$//;
my $content=$txt{$tab}->get("$index", "$ln.end");
chomp $content;
(my $swap=$content) =~ s/'/**/g;
($content=$swap) =~ s/^/'/;
($swap=$content) =~ s/$/'/;
system "vim --remote-send $swap";
$VW[$wn]->title("line $ln sent to vim");
}
sub trimbox { $regexp = $reg_EN->get() || return "No regexp!";
fillbox();
my %N_index;
foreach my $name (@dirray) { (my $file=$name) =~ s/^\*+//;
open (CXF, "$files{$file}") || next;
my $content = do {local $/; <CXF>};
close (CXF);
my $N;
if ($case eq "nocase") {if ($content =~ /$regexp/i) {
$_=$content;
$N =()= /$regexp/gi;
$N_index{$file}=$N;
}} elsif ($case eq "case") {if ($content =~ /$regexp/) {
$_=$content;
$N =()= /$regexp/g;
$N_index{$file}=$N;
}}
}
@dirray = sort {$N_index{$b} <=> $N_index{$a}} keys %N_index;
my $i=0;
foreach my $file (@dirray) {
my $copy=$file;
$file =~ s/$/ ($N_index{$copy})/;
if (exists($loc{$copy}) && $loc{$copy} =~ /-/) {
$_ = "$loc{$file}";
my $x =()= /-/g;
my $n=0;
until ($n==$x) {
$file =~ s/^/\*/;
$DLB->activate($i);
$n++}
}
$i++}
$MW->title("TkCodex");
}
sub txtbmk { my $tab=shift; (my $wn=$tab)=~s/^[A-D]-//;
my $cmmd=shift;
if ($cmmd eq "place") {
linenumber($tab);
$bmark="$c_pos[0].$c_pos[1]";
$VW[$wn]->title("Bookmark set at line $c_pos[0]");
}
else {$txt{$tab}->SetCursor($bmark)}
}
sub undored { my $wn=shift;
my $tab = $NB[$wn]->raised();
my $match = $VW_EN[$wn]->get();
unless ($match =~ /\w/) {return "No search criteria!"}
tkhistory(\$VW_EN[$wn], "add", $TEhist);
if ($LBsw{$tab}==1) {switchlist($wn)}
my $ray=\@{$LBlist{$tab}};
my @replacement;
for (my $i=0;$i<scalar @$ray;$i++) {
if ($$ray[$i]{content} eq $match) {if ($$ray[$i]{type} eq "red") {
$txt{$tab}->tagRemove('red', $$ray[$i]{start}, $$ray[$i]{end});
next}}
push @replacement, $$ray[$i];
}
@$ray=@replacement;
formlist($tab);
}
sub unlite { (my $n=$_[0])=~s/unlite-//;
$instances[$n]=0;
my $unexact = $VW_EN[$n]->get();
if ($unexact eq "") {return}
tkhistory(\$VW_EN[$n], "add", $TEhist);
my $tab = $NB[$n]->raised();
if ($LBsw{$tab}==1) {switchlist($n)}
my $type;
if ($case eq "nocase" && $RGXP[$n] eq "no") {$type="NORM"}
elsif ($case eq "case" && $RGXP[$n] eq "no") {$type="UC"}
elsif ($case eq "case" && $RGXP[$n] eq "yes") {$type="RXUC"}
else {$type="RX"}
my $ray=\@{$LBlist{$tab}};
my @replacement;
for (my $i=0;$i<scalar @$ray;$i++) {
if ($$ray[$i]{content} eq $unexact) {if ($$ray[$i]{type} eq $type) {next}}
push @replacement, $$ray[$i];
}
@$ray=@replacement;
formlist($tab);
markup($tab);
}