#!/usr/bin/perl -w use strict; ### TkCodex ### (c) 2008 ############### halfcountplus use File::Find; use Tk; use Tk::NoteBook; use Tk::ROText; use DB_File; ######## configure ################### my $CXdir="/home/user/rabbithole/disaster"; if (defined $ARGV[0]) {unless (defined($ARGV[1])) {die "Filename exten + sion required with path...

"}} my $MW = MainWindow->new; $MW->title("TkCodex (Press F1)"); $MW->setPalette(background=>'#ffffff',foreground=>'#360C7A',activeFore + ground=>'black',activeBackground=>'#FF0000',selectBackground=>'yellow + ',selectForeground=>'#00aa00'); my (%files, %info, %loc); # entries (dir, suffix, regexp) 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=>5,-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=""; # directory listbox (DLB) my @dirray; my $list=\@dirray; # reference an array (since "-listva + riable" must be scalar my $DLB = $MW->Listbox(-height=>12,-width=>33,-listvariable=>$list,-ta + kefocus=>'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,"4"=>sub{addto(3)}); $DLB->bind($DLB,"<<ListboxSelect>>"=>sub{showloc("CLEAR")}); $DLB->bind($DLB,"<Button-3>"=>sub{my $file=$DLB->get('active'); showloc($file)}); # Number of occurances listbox (NLB) my @Nray; my $num=\@Nray; my $NLB = $MW->Listbox(-height=>12,-width=>3,-listvariable=>$num,-take + focus=>'0'); $NLB->configure(-background=>'#BBBBFF',-foreground=>'#0000FF'); # buttons my $dir_BT = $MW->Button(-text=>'dir',-font=>'courier-14',-command=>su + b{$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',-comma + nd=>sub{messagemain(\&trimbox)}); $regexp_BT->configure(-background=>'#360C7A',-foreground=>'#EEFA3F'); my $CLEARALL_BT = $MW->Button(-text=>'CLEARALL',-font=>'courier-14',-c + ommand=>sub{foreach (0..3) {clearall("all-$_")}}); $CLEARALL_BT->configure(-background=>'#360C7A',-foreground=>'#EEFA3F') + ; # labels 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'); # case checkbutton my $case = "nocase"; my $case_CB = $MW -> Checkbutton(-text=>'case',-variable=>\$case,-onva + lue=>"case",-offvalue=>"nocase",-command=>sub{caselight()},-font=>"co + urier-14"); ### G R I D (MainWindow) ### $dir_EN->grid(-row=>0,-column=>0,-columnspan=>4); $suf_lab->grid(-row=>1,-column=>1,-sticky=>'e'); $suf_EN->grid(-row=>1,-column=>2,-sticky=>'w'); $dir_BT->grid(-row=>1,-column=>3,-sticky=>'e'); $NLB->grid(-row=>2,-column=>0); $DLB->grid(-row=>2,-column=>1,-columnspan=>3); $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); $CLEARALL_BT->grid(-row=>4,-column=>2,-columnspan=>2); $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',"<Key-F4>"=>sub{toggle(3)}); $MW->bind('all',"<Control-Q>"=>sub{exit}); ####################### # withdrawn toplevels # ####################### ########### TXT_Note ### my %TXT_Note; $TXT_Note{toplevel} = $MW->Toplevel(-title=>"N O T E"); $TXT_Note{topl + evel}->state('withdrawn'); $TXT_Note{text} = $TXT_Note{toplevel}->Text(-wrap=>'word')->pack(); $TXT_Note{text}->configure(-font=>'courier 12',-width=>50,-height=>10, + -foreground=>'white',-background=>'#111111'); $TXT_Note{done} = $TXT_Note{toplevel}->Button(-text=>'done',-font=>'co + urier-14',-command=>sub{notecreate()})->pack(); $TXT_Note{text}->bind("<Control-c>"=>sub{$TXT_Note{toplevel}->withdraw + }); $TXT_Note{done}->configure(-background=>'#360C7A',-foreground=>'#eefa3 + f'); ## popup edit menu 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}->clipboardPast + e}], ]); $popM->configure(-background=>"#360C7A",-foreground=>"#EEFA3F"); $TXT_Note{text}->bind("<Button-3>"=>sub{$popM->Popup(-popover=>"cursor + ",-popanchor=>'nw')}); ########### ViewWindows (VW) ### my (@VW, @NB, %pg, %txt, %VW_BT, @VW_EN, %notes, %tag_LB, @history, $h + count, %LN_lab, @VW_wc, @WC, @VW_num, @VW_case, @RGXP, @VW_rgxp); foreach (0..3) { my $wn=$_; (my $title = $_)+=1; $VW[$_] = $MW->Toplevel(-title=>"$title"); $VW[$_]->state('withdra + wn'); } $VW[0]->configure(-background=>'#BBFFBB',-foreground=>'#360C7A'); $VW[1]->configure(-background=>'#BBBBFF',-foreground=>'#000000'); $VW[2]->configure(-background=>'#F1CE07',-foreground=>'#0000AA'); $VW[3]->configure(-background=>'#D6A67A',-foreground=>'#360C7A'); $VW[0]->geometry('1264x750+0+0'); $VW[1]->geometry('1264x750+0+0'); $VW[2]->geometry('1264x750+0+0'); $VW[3]->geometry('1264x750+0+0'); my @instances=(0,0,0,0); my $caselight=""; ######################################## foreach (0..3) { my $num=$_; ######### buttons, etc. at top ######### my $bgcolor; if ($_==0) {$bgcolor="#bbffbb"} if ($_==1) {$bgcolor="#bbbbff"} if ($_==2) {$bgcolor="#f1ce07"} if ($_==3) {$bgcolor="#d6a67a"} my $BT1 = "clear-$_"; # clear $VW_BT{$BT1} = $VW[$_]->Button(-text=>'clear',-font=>'courier-14', + -command=>sub{cleartab($BT1)}); $VW_BT{$BT1}->configure(-background=>'#360C7A',-foreground=>'#eefa + 3f'); $VW_BT{$BT1}->place(-x=>20,-y=>4,-width=>80); my $BT2 = "all-$_"; # clear all $VW_BT{$BT2} = $VW[$_]->Button(-text=>'all',-font=>'courier-14',-c + ommand=>sub{clearall($BT2)}); $VW_BT{$BT2}->configure(-background=>'#360C7A',-foreground=>'#eefa + 3f'); $VW_BT{$BT2}->place(-x=>102,-y=>4,-width=>60); my $BT6 = "tags-$_"; # clear tags $VW_BT{$BT6} = $VW[$_]->Button(-text=>'tags',-font=>'courier-14',- + command=>sub{cleartags($BT6)}); $VW_BT{$BT6}->configure(-background=>'#360C7A',-foreground=>'#eefa + 3f'); $VW_BT{$BT6}->place(-x=>164,-y=>4); ## number of instances + # $VW_num[$_] = $VW[$_]->Label(-textvariable=>\$instances[$_],-font= + >'helvetica 24 bold',-foreground=>'#000000',-background=>"$bgcolor"); $VW_num[$_]->place(-x=>253,-y=>-10,-width=>110); ## caselight # $VW_case[$_] = $VW[$_]->Label(-textvariable=>\$caselight,-font=>'h + elvetica 24 bold',-foreground=>'#cc0000',-background=>"$bgcolor"); $VW_case[$_]->place(-x=>383,-y=>-10,-width=>15); my $BT5 = "unlite-$_"; # unlite $VW_BT{$BT5} = $VW[$_]->Button(-text=>'unlite',-font=>'courier-14' + ,-command=>sub{unlite($BT5)}); $VW_BT{$BT5}->configure(-background=>'#764CbA',-foreground=>'#eefa + 3f'); $VW_BT{$BT5}->place(-x=>400,-y=>4,-width=>100); $history[0]=" "; ### T E X T E N T R Y ### $VW_EN[$_] = $VW[$_]->Entry(-font=>'helvetica 12 italic',-validate + =>'focus',-validatecommand=>sub{$hcount=0}); $VW_EN[$_]->place(-x=>502,-y=>4,-width=>200); $VW_EN[$_]->bind("<Key-Up>"=>sub{historylist("-1","$num")}); $VW_EN[$_]->bind("<Key-Down>"=>sub{historylist("1","$num")}); my $BT4 = "hilite-$_"; # hilite $VW_BT{$BT4} = $VW[$_]->Button(-text=>'hilite',-font=>'courier-14' + ,-command=>sub{hilite_BT($BT4)}); $VW_BT{$BT4}->configure(-background=>'#764CbA',-foreground=>'#eefa + 3f'); $VW_BT{$BT4}->place(-x=>704,-y=>4,-width=>100); $RGXP[$_] = "no"; ## regexp checkbutton ## $VW_rgxp[$_] = $VW[$_] -> Checkbutton(-text=>'regexp',-variable=>\ + $RGXP[$num],-onvalue=>"yes",-offvalue=>"no",-font=>"courier-10",-back + ground=>"$bgcolor",-relief=>'solid'); $VW_rgxp[$_]->place(-x=>810,-y=>4); my $BT3 = "first-$_"; # 1st 4 $VW_BT{$BT3} = $VW[$_]->Button(-text=>'1st 4',-font=>'courier-14', + -command=>sub{onefour($BT3)}); $VW_BT{$BT3}->configure(-background=>'#360C7A',-foreground=>'#eefa + 3f'); $VW_BT{$BT3}->place(-x=>970,-y=>4); my $BT7 = "save-$_"; # save $VW_BT{$BT7} = $VW[$_]->Button(-text=>'save',-font=>'courier-14',- + command=>sub{messagable(\&savetags, "$num", "$BT7")}); $VW_BT{$BT7}->configure(-background=>'#360C7A',-foreground=>'#eefa + 3f'); $VW_BT{$BT7}->place(-x=>1100,-y=>4,-width=>'75'); my $BT8 = "load-$_"; # load $VW_BT{$BT8} = $VW[$_]->Button(-text=>'load',-font=>'courier-14',- + command=>sub{messagable(\&loadtags, "$num", "$BT8")}); $VW_BT{$BT8}->configure(-background=>'#360C7A',-foreground=>'#eefa + 3f'); $VW_BT{$BT8}->place(-x=>1177,-y=>4,-width=>'75'); ################################################################## + ###### $NB[$_] = $VW[$_]->NoteBook(); ### notebook pager ############# + ######## $NB[$_]->configure(-background=>'#360C7A',-foreground=>'#EEFA3F'); if ($_ == 0) {$NB[$_]->configure(-backpagecolor=>'#BBFFBB')} elsif ($_ == 1) {$NB[$_]->configure(-backpagecolor=>'#BBBBFF')} elsif ($_ == 2) {$NB[$_]->configure(-backpagecolor=>'#F1CE07')} elsif ($_ == 3) {$NB[$_]->configure(-backpagecolor=>'#D6A67A')} $NB[$_]->place(-x=>2,-y=>52); foreach my $L ("A","B","C","D") { my $tab = "$L-$num"; $pg{$tab} = $NB[$num]->add($tab,-label=>'E M P T Y',-raisecmd= + >sub{tabup($tab)}); $txt{$tab} = $pg{$tab}->ROText(-wrap=>'none'); ## tag i + ndex listbox $tag_LB{$tab} = $pg{$tab}->Listbox(-height=>22,-width=>20,-fon + t=>'helvetica 12 italic',-selectmode=>'extended'); $LN_lab{$tab} = $pg{$tab}->Label(-font=>'helvetica 14 bold',-f + oreground=>'#cc0000'); if ($num eq 0) {$pg{$tab}->configure(-background=>'#99cc99',-f + oreground=>'#360c7a')} if ($num eq 0) {$LN_lab{$tab}->configure(-background=>'#99cc99 + ')} if ($num eq 1) {$pg{$tab}->configure(-background=>'#8888aa',-f + oreground=>'#000000')} if ($num eq 1) {$LN_lab{$tab}->configure(-background=>'#8888aa + ')} if ($num eq 2) {$pg{$tab}->configure(-background=>'#c1ae00',-f + oreground=>'0000aa')} if ($num eq 2) {$LN_lab{$tab}->configure(-background=>'#c1ae00 + ')} if ($num eq 3) {$pg{$tab}->configure(-background=>'#b6865a',-f + oreground=>'#360c7a')} if ($num eq 3) {$LN_lab{$tab}->configure(-background=>'#b6865a + ')} $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); } $WC[$_] = "no"; ### working copy checkbutton ### $VW_wc[$_] = $VW[$_] -> Checkbutton(-text=>'working copy',-variabl + e=>\$WC[$num],-onvalue=>"yes",-offvalue=>"no",-font=>"courier-12"); $VW_wc[$_]->place(-x=>1100,-y=>42); } $NB[0]->configure(-background=>'#88bb88',-foreground=>'#360C7A'); $VW_wc[0]->configure(-background=>'#88bb88',-foreground=>'#360C7A'); $NB[1]->configure(-background=>'#8888aa',-foreground=>'#000000'); # + # color ## $VW_wc[1]->configure(-background=>'#8888aa',-foreground=>'#000000'); + # schemes # $NB[2]->configure(-background=>'#b19e00',-foreground=>'#0000AA'); $VW_wc[2]->configure(-background=>'#b19e00',-foreground=>'#0000AA'); $NB[3]->configure(-background=>'#a6764a',-foreground=>'#360C7A'); $VW_wc[3]->configure(-background=>'#a6764a',-foreground=>'#360C7A'); my @LBBG = ("#BBBBFF", "#F1CE07", "#D6A67A", "#BBFFBB"); foreach (keys %txt) { my $tab="$_"; ### text areas & tagging # + ## (my $wn=$tab) =~ s/^[A-D]-//; %{$notes{$tab}}=(); $txt{$_}->configure(-font=>'courier 12',-width=>106,-height=>34,-f + oreground=>'black',-background=>'white'); $txt{$_}->tagConfigure('bold',-foreground=>'#360C7A',-font=>'couri + er 12 bold italic'); $txt{$_}->tagConfigure('red',-foreground=>'#cc0000',-font=>'courie + r 12 bold'); $txt{$_}->tagConfigure('green',-foreground=>'#00cc00',-font=>'cour + ier 12 bold'); $txt{$_}->tagConfigure('marked',-foreground=>'white',-background=> + '#000000',-font=>'courier 12 italic'); $txt{$_}->tagConfigure('QRbold',-font=>'courier 12 bold'); $txt{$_}->tagConfigure('QRitalic',-font=>'courier 12 italic'); $txt{$_}->tagBind('marked', "<Control-Button-1>", sub{displaynote( + $tab)}); $txt{$_}->menu(undef); # key bindings $txt{$_}->bind("<Button-3>"=>sub{$txt{$tab}->FindSelectionNext;lin + enumber($tab)}); $tag_LB{$_}->bind("<Button-3>"=>sub{gototag($tab)}); $tag_LB{$_}->bind("<Button-2>"=>sub{removetag($tab)}); $tag_LB{$_}->bind("<Control-Button-1>"=>sub{locktag($tab)}); $txt{$_}->bind("<Button-2>"=>sub{$txt{$tab}->FindSelectionPrevious + ;linenumber($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{unline($tab)}); $txt{$_}->bind("<Control-c>"=>sub{charpos($tab)}); $txt{$_}->bind("<Control-e>"=>sub{messagable(\&unsearch, $wn, $tab + )}); $txt{$_}->bind("<Control-g>"=>sub{gotoLN($tab)}); $txt{$_}->bind("<Control-G>"=>sub{goback($tab)}); $txt{$_}->bind("<Control-h>"=>sub{quickref($tab)}); $txt{$_}->bind("<Control-o>"=>sub{$tag_LB{$tab}->yviewScroll(-1,'u + nits')}); $txt{$_}->bind("<Control-l>"=>sub{$tag_LB{$tab}->yviewScroll(1,'un + its')}); $txt{$_}->bind("<Control-i>"=>sub{$txt{$tab}->yviewScroll(-1,'unit + s')}); $txt{$_}->bind("<Control-k>"=>sub{$txt{$tab}->yviewScroll(1,'units + ')}); $txt{$_}->bind("<Control-m>"=>sub{marknote($tab)}); $txt{$_}->bind("<Control-n>"=>sub{linenumber($tab)}); $txt{$_}->bind("<Control-p>"=>sub{linenumber($tab)}); $txt{$_}->bind("<Control-r>"=>sub{$txt{$tab}->tagAdd('red', 'sel.f + irst', 'sel.last')}); $txt{$_}->bind("<Control-R>"=>sub{messagable(\&findall, $wn, $tab, + 'red')}); $txt{$_}->bind("<Control-s>"=>sub{messagable(\&findall, $wn, $tab, + 'green')}); $txt{$_}->bind("<Control-S>"=>sub{litesubs($tab)}); $txt{$_}->bind("<Control-u>"=>sub{$txt{$tab}->tagRemove('red', 'se + l.first', 'sel.last')}); $txt{$_}->bind("<Control-U>"=>sub{unsubs($tab)}); $txt{$_}->bind("<Control-v>"=>sub{tovim($tab)}); $txt{$_}->bind("<Control-9>"=>sub{messagable(\&numbering, $wn, $ta + b, '-')}); $txt{$_}->bind("<Control-0>"=>sub{messagable(\&numbering, $wn, $ta + b, '+')}); $txt{$_}->tagConfigure('hlite',-foreground=>'#360C7A',-background= + >"$LBBG[$wn]",-font=>'courier 12 bold italic'); $tag_LB{$_}->configure(-background=>"$LBBG[$wn]"); $txt{$_}->tagRaise('marked'); $txt{$_}->tagRaise('hlite', 'bold'); $txt{$_}->tagLower('red', 'bold'); } #################################### ###################################### ## start-up ######## #################### my (@swapray, @tags, $notetab, $noteindex, @bookmarks); my $where=1; 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" is a hash of arrays @{$info{'A-2'}}=("3"); # for the titlebar @{$info{'A-3'}}=("4"); my $DATA_START = tell(DATA); quickref('A-0'); 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/^\*+//; messagable(\&dofile, $wn, $name, $tab); last} } } sub bookmarks { my $do=$_[0]; if ($do eq 'load') { open (BM, "<$CXdir/tkcodex.bookmarks") || 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 exis + ts"}} push @bookmarks, $entry; sysopen (BM, "$CXdir/tkcodex.bookmarks", O_WRONLY | O_APPEND | + O_CREAT) || return "no bookmark file!"; print BM "$entry

"; close (BM); return "+$entry"; } if ($do eq 'subtract') { my $entry=$dir_EN->get(); my @new = grep { $_ ne "$entry"} @bookmarks; @bookmarks = @new; open (BM, ">$CXdir/tkcodex.bookmarks") || return "no bookmark + file!"; foreach (@bookmarks) {print BM "$_

"}; 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 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'); $tag_LB{$tab}->delete('0','end'); $NB[$num]->pageconfigure($tab,-label=>"E M P T Y"); %{$notes{$tab}}=(); 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"); } sub cleartab { (my $num=$_[0])=~s/clear-//; $instances[$num]=0; my $clear = $NB[$num]->raised(); $txt{$clear}->delete('1.0','end'); $tag_LB{$clear}->delete('0','end'); %{$notes{$clear}}=(); $NB[$num]->pageconfigure($clear,-label=>"E M P T Y"); if (defined($loc{$info{$clear}[1]})) { # only the "Quick R + eference" $loc{$info{$clear}[1]}=~s/\s?$clear//; # should fail this i + f $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'); } sub cleartags { (my $wn=$_[0])=~s/tags-//; $instances[$wn]=0; my $tab = $NB[$wn]->raised(); $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'); $tag_LB{$tab}->delete('0', 'end'); %{$notes{$tab}}=(); } sub displaynote { my $tab="@_"; (my $wn=$tab)=~s/^[A-D]-//; my @index = split /\./,$txt{$tab}->index('insert'); foreach my $line (keys %{$notes{$tab}}) { $line=~/^X:(\d+)\.(\d+)\+(\d+)/; my @ref = ("$1", "$2"); (my $limit = $2)+=$3; if ($ref[0] == $index[0] && $index[1] >= $ref[1] && $index[1] + <= $limit) { my $match=$txt{$tab}->get("$ref[0].$ref[1]", "$ref[0].$lim + it"); $txt{$tab}->GotoLineNumber("$ref[0]"); messagable(\¬eup, $wn, $tab, $match); return; } } } 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/^/\*/; $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} hilite("$tab", "$regexp", "def"); $txt{$tab}->GotoLineNumber(1); $NB[$wn]->raise($tab); } sub fillbox { my $sfx = $suf_EN->get() || return "No suffix!"; %files=(); @Nray = (""); # seems "" needed if NLB is to be erased my $dir=$dir_EN->get(); find(\&getfiles, $dir); # find must call a function @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; # this places astericks in the MW listbox 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]; $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}->FindA + ll(-regexp, -nocase, "$exact")} elsif ($case eq "case"&& $RGXP[$wn] eq "yes") {$txt{$tab}->FindAll + (-regexp, -case, "$exact")} my @found = $txt{$tab}->tagRanges('sel'); while (defined($found[0])) { my $begin = shift @found; my $end = shift @found; $txt{$tab}->tagAdd("$rgb", "$begin", "$end"); $instances[$wn]++; } if ($case eq "nocase" && $RGXP[$wn] eq "no") {$txt{$tab}->FindNext + (-forward,-exact, -nocase, "$exact")} elsif ($case eq "case" && $RGXP[$wn] eq "no") {$txt{$tab}->FindNex + t(-forward,-exact, -case, "$exact")} elsif ($case eq "nocase" && $RGXP[$wn] eq "yes") {$txt{$tab}->Find + Next(-forward,-regexp, -nocase, "$exact")} elsif ($case eq "case" && $RGXP[$wn] eq "yes") {$txt{$tab}->FindNe + xt(-forward,-regexp, -case, "$exact")} linenumber($tab); $VW[$wn]->title("@{$info{$tab}} ($exact) $rgb-lit"); foreach my $past (@history) {if ($past eq $exact) {return}} push @history, $exact; } sub getfiles { my $sfx = $suf_EN->get() || return; unless (-d) {if (/\.$sfx$/) { my $tmp = $File::Find::name; if (exists($files{$_})) { my $dir=$dir_EN->get(); ($_=$tmp)=~s/^\/?$dir\/?//; } push @swapray, $_; $files{$_} = $tmp; }} } sub goback { my $tab="@_"; (my $place=$txt{$tab}->index('insert'))=~s/\.\d+$//; $txt{$tab}->GotoLineNumber("$where"); $where=$place; } sub gotoLN { my $tab="@_"; (my$wn=$tab)=~s/^[A-D]-//; (my $place=$txt{$tab}->index('insert'))=~s/\.\d+$//; 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="@_"; (my $wn=$tab)=~s/^[A-D]-//; ($where = $txt{$tab}->index('insert')) =~ s/\.\d+$//; my $this=$tag_LB{$tab}->get('active'); my @that = split /(:.)/,$this; $txt{$tab}->GotoLineNumber("$that[0]"); $LN_lab{$tab}->configure(-text=>"line $that[0]"); } 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 $sw="okay"; # switch on match foreach my $past (@history) {if ($past eq $exact) {$sw="DONE"}} unless ($sw eq "DONE") {push @history, $exact} my $tab = $NB[$n]->raised(); hilite("$tab", "$exact"); } sub hilite { my $tab="$_[0]"; my $expre = "$_[1]"; (my $wn = $tab)=~s/ + ^[A-D]-//; @tags = $tag_LB{$tab}->get('0','end'); ### retrieve index my $chars=0; my @start=("1","0"); $instances[$wn] = 0; while (1) { my $x; ### search/highlight loop ### if ((defined($_[2]) || $RGXP[$wn] eq "yes") && $case eq "nocas + e") {$x = $txt{$tab}->search(-regexp,-nocase,-count=>$chars,"$expre", + "$start[0].$start[1]", 'end')} elsif ((defined($_[2]) || $RGXP[$wn] eq "yes") && $case eq "ca + se") {$x = $txt{$tab}->search(-regexp,-count=>$chars,"$expre","$start + [0].$start[1]", 'end')} elsif ($case eq "nocase") {$x = $txt{$tab}->search(-exact,-noc + ase,-count=>$chars,"$expre","$start[0].$start[1]", 'end')} elsif ($case eq "case") {$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} # all this is because, eg. 15.16 < 15.5 (altho probably obsele + ted by 'end' in search) if ($index[0] == $start[0] && $index[1] <= $start[1]) {last} $instances[$wn]++; $txt{$tab}->tagAdd('bold', "$index[0].0", "$index[0].0 lineend + "); if ((defined($_[2]) || $RGXP[$wn] eq "yes") && $case eq "case" + ) {push @tags, "$index[0]:!$expre"} elsif ((defined($_[2]) || $RGXP[$wn] eq "yes") && $case eq "no + case") {push @tags, "$index[0]:~$expre"} elsif ($case eq "case") {push @tags, "$index[0]:^$expre"} elsif ($case eq "nocase") {push @tags, "$index[0]: $expre"} (my $y = $index[1])+=$chars; $txt{$tab}->tagAdd('hlite', "$x", "$index[0].$y"); @start=("$index[0]","$y"); } LBindex($tab); } sub historylist { my $adj=$_[0]; my $n=$_[1]; (my $tmp=$hcount)+=$adj; if (defined($history[$tmp])) {$hcount=$tmp; $VW_EN[$n]->delete('0','end'); $VW_EN[$n]->insert('1',$history[$hcount]); } else {$hcount=0} } sub LBindex { my $tab = "@_"; $tag_LB{$tab}->delete('0','end'); my @swap = sort {($a=~/^(\d+):/)[0] <=> ($b=~/^(\d+):/)[0]} @tags; (my $wn = $tab) =~ s/^[A-D]-//; ${$info{$tab}}[2]=" "; my $lastline=""; foreach my $line (@swap) { if ($lastline eq $line) {next} $tag_LB{$tab}->insert('end',"$line"); $lastline=$line; } $VW[$wn]->title("@{$info{$tab}}"); } sub linenumber { my $tab="@_"; (my $wn=$tab)=~s/^[A-D]-//; $VW[$wn]->title("@{$info{$tab}}"); (my $index=$txt{$tab}->index('insert'))=~s/\.\d+$//; $LN_lab{$tab}->configure(-text=>"line $index"); } sub litesubs { (my $wn=$_[0])=~s/^[A-D]-//; my $tab=$NB[$wn]->raised() + ; my $length; my $content=$txt{$tab}->Contents(); my @contents=split /

/,$content; @tags = $tag_LB{$tab}->get('0','end'); foreach (my $i=0;$i<@contents;$i++) { if ($contents[$i] =~ /(^\s*sub \w+\s*{)/) { my $length=length $1; $length--; (my $ln=$i)+=1; my $listing="$ln: $1"; $txt{$tab}->tagAdd('hlite', "$ln.0", "$ln.$length"); push @tags, $listing; } } my @swap = sort {($a=~/^(\d+):/)[0] <=> ($b=~/^(\d+):/)[0]} @tags; $tag_LB{$tab}->delete('0', 'end'); foreach my $line (@swap) { # redo listbox $tag_LB{$tab}->insert('end',"$line"); } $VW[$wn]->title("@{$info{$tab}} subrountine highlighting on"); } sub loadtags { (my $wn="$_[0]") =~ s/load-//; $instances[$wn]=0; my $tab=$NB[$wn]->raised(); (my $name="@{$info{$tab}}[1]") =~ s/\//_/; $VW[$wn]->title("loading tags for $name from $CXdir..."); if ($WC[$wn] eq "yes") { $txt{$tab}->delete('1.0','end'); $tag_LB{$tab}->delete('0','end'); %{$notes{$tab}}=(); open (WC, "$CXdir/$name.cdx.wc") || return "NO WORKING COPY!!" + ; while (<WC>) { $txt{$tab}->Insert("$_") } close (WC); @tags = (); $txt{$tab}->GotoLineNumber(1); $WC[$wn] = "no"; } else {@tags = $tag_LB{$tab}->get('0','end')} open (TF, "<$CXdir/$name.cdx") || return "ERROR: no $CXdir/$name.c + dx!"; my @red; while (<TF>) { chomp $_; if ($_ =~ /^RED:/) {@red = split / /,$_; shift @red; next} push @tags,$_; if ($_ =~ /^\d+:\*/) {next} processbold ("$tab", "$_"); } close (TF); LBindex($tab); my $e = scalar @red; for (my $i=0;$i<$e;$i+=2) { my $begin = shift @red; my $end = shift @red; $txt{$tab}->tagAdd('red', "$begin", "$end"); } my %tmp; dbmopen %tmp, "$CXdir/$name.cdx.db", 0444 || return "no additional + notes for $name"; foreach (keys %tmp) { ${notes{$tab}}{$_}=$tmp{$_}; $_=~/^X:(\d+)\.(\d+)\+(\d+)$/; my $line=$1; my $start=$2; (my $end=$start)+=$3; $txt{$tab}->tagAdd('marked', "$line.$start", "$line.$end"); } dbmclose %tmp; } sub locktag { my $tab="@_"; (my $wn=$tab)=~s/^[A-D]-//; my @saved = $tag_LB{$tab}->curselection; foreach my $N (@saved) { my $value = $tag_LB{$tab}->itemcget($N, -background); if (!defined($value)) { $tag_LB{$tab}->itemconfigure($N,-background=>'white'); next} elsif ($value eq 'white') {$tag_LB{$tab}->itemconfigure($N,-ba + ckground=>"$LBBG[$wn]")} else {$tag_LB{$tab}->itemconfigure($N,-background=>'white')} } } sub marknote { my $tab="@_"; @tags = $tag_LB{$tab}->get('0','end'); $txt{$tab}->index('sel.last')=~/^(\d+).(\d+)$/; my $sel_last_line=$1; my $sel_last_char=$2; $txt{$tab}->index('sel.first')=~/^(\d+).(\d+)$/; my $sel_first_line=$1; my $sel_first_char=$2; $txt{$tab}->index("$sel_first_line.end")=~/^\d+.(\d)$/; my $linend=$1; my $end; (my $limit=$sel_first_char)+=27; if ($sel_last_line > $sel_first_line) { if ($linend > $limit) {$end="$sel_first_line.$limit"} else {$end="$sel_first_line.$linend"} } else {if ($sel_last_char > $limit) {$end="$sel_first_line.$limit + "} else {$end="$sel_first_line.$sel_last_char"} } $txt{$tab}->tagAdd('marked', 'sel.first', "$end"); my $detail = $txt{$tab}->get('sel.first', "$end"); my $listing="$sel_first_line:*$detail"; push @tags, $listing; my @swap = sort {($a=~/^(\d+):/)[0] <=> ($b=~/^(\d+):/)[0]} @tags; $tag_LB{$tab}->delete('0','end'); foreach my $line (@swap) { # redo listbox $tag_LB{$tab}->insert('end',"$line"); } $TXT_Note{toplevel}->state('normal'); $TXT_Note{toplevel}->title("${$info{$tab}}[1]: line $sel_first_lin + e"); my $length=length $detail; $notetab=$tab; $noteindex="X:$sel_first_line.$sel_first_char+$leng + th"; # the global "$notetab" and "$noteindex" variables are for notecre + ate() invoked by "done" button in TXT_Note } sub messagable { my $func= shift @_; my $wn = shift @_; my $message=$func->(@_); 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(); chomp $note; ${$notes{$notetab}}{$noteindex}=$note; $TXT_Note{text}->delete('1.0', 'end'); $TXT_Note{toplevel}->withdraw; } sub noteup { $notetab=$_[0]; my $match=$_[1]; $TXT_Note{text}->delete('1.0', 'end'); my $next=""; my @check; my $x=0; until ($next eq $match) { @check=$txt{$notetab}->tagNextrange('marked', 'insert', 'inser + t lineend'); unless (defined($check[1]) && $x ne $check[0]) {return "wrong + line number!"}; $next=$txt{$notetab}->get("$check[0]", "$check[1]"); $x=$check[0]; } foreach my $index (keys %{$notes{$notetab}}) { if ($index =~ /^X:$check[0]\+/) { $noteindex=$index; $TXT_Note{toplevel}->state('normal'); $TXT_Note{text}->Insert("${$notes{$notetab}}{$index}"); $TXT_Note{text}->GotoLineNumber('1'); $index=~/^X:(\d+)\./; #now $1 = the line number for TXT_No + te's titlebar $TXT_Note{toplevel}->title("${$info{$notetab}}[1]: line $1 + "); return; } } } 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]->d + elete('0', 'end')} unless ($int =~ /^\d+$/) {$int=1} if ($way eq "-") {$int=-$int} my $start = int $txt{$tab}->index('insert'); (my $posvalue=$start)+=$int; if ($posvalue <= 0) {return "can't do that! (the number is too big + )"} @tags = $tag_LB{$tab}->get('0','end'); my @swap = @tags; my $i=0; foreach my $index (@tags) { $index=~/^(\d+):(.)(.+)$/; my $LN=$1; my $type=$2; my $match=$3; if ($LN > $start) { (my $new=$LN)+=$int; $swap[$i]="$new:$type$match"; if ($type eq "*") { $txt{$tab}->tagRemove('marked', "$LN.0", "$LN.1 lineen + d"); foreach my $key (keys %{$notes{$tab}}) {if ($key =~ /^ + X:$LN/) { (my $rep = $key) =~ s/^X:$LN/X:$new/; ${$notes{$tab}}{$rep} = ${$notes{$tab}}{$key}; delete ${$notes{$tab}}{$key}; $key=~/^X:\d+\.(\d+)\+(\d+)/; (my $end=$1)+=$2; $txt{$tab}->tagAdd('marked', "$new.$1", "$new.$end + "); }} } else {$txt{$tab}->tagRemove('hlite', "$LN.0", "$LN.1 lin + eend"); $txt{$tab}->tagRemove('bold', "$LN.0", "$LN.1 lineend" + ); processbold ("$tab", "$swap[$i]")} } $i++} @tags = sort {($a=~/^(\d+):/)[0] <=> ($b=~/^(\d+):/)[0]} @swap; $tag_LB{$tab}->delete('0', 'end'); foreach my $line (@tags) { # redo listbox $tag_LB{$tab}->insert('end',"$line"); } # now do 'red' tags my @red = $txt{$tab}->tagRanges('red'); unless (defined($red[0])) {return} foreach my $pos (@red) {my @ln=split /\./,$pos; if ($ln[0]>$start) {$ln[0]+=$int; $pos="$ln[0].$ln[1]"} } $txt{$tab}->tagRemove('red', '1.0', 'end'); my $e = scalar @red; for (my $i=0;$i<$e;$i+=2) { my $begin = shift @red; my $end = shift @red; $txt{$tab}->tagAdd('red', "$begin", "$end"); } } 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) { messagable(\&dofile, $num, $dirray[$i], $opentabs[$i])} $NB[$num]->raise("A-$num"); } 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]","$in + dex[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]","$i + ndex[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 quickref { my $tab=$_[0]; (my $wn=$tab)=~s/^[A-D]-//; if ($info{$tab}[0] !~ /^\d$/) {return} else {@{$info{$tab}}=("TkCodex", "Quick Reference")} while (<DATA>) { if ($_ =~ /^!!!/) { my @effect = split / /, $_; shift @effect; my $e = scalar @effect; for (my $i=0;$i<$e;$i+=2) { my $begin = shift @effect; my $end = shift @effect; if ($_ =~ /^!!!RED:/) {$txt{$tab}->tagAdd('red', "$beg + in", "$end")} if ($_ =~ /^!!!BOLD:/) {$txt{$tab}->tagAdd('QRbold', " + $begin", "$end")} if ($_ =~ /^!!!GREEN:/) {$txt{$tab}->tagAdd('green', " + $begin", "$end")} if ($_ =~ /^!!!IT:/) {$txt{$tab}->tagAdd('QRitalic', " + $begin", "$end")} if ($_ =~ /^!!!BII:/) {$txt{$tab}->tagAdd('bold', "$be + gin", "$end")} if ($_ =~ /^!!!REV:/) {$txt{$tab}->tagAdd('marked', "$ + begin", "$end")} } } elsif ($_ =~ /\+\+\+\d+:/) { $_ =~ s/^\+\+\+//; chomp $_; push @tags,$_; processbold($tab, "$_"); } else {$txt{$tab}->Insert($_)} } seek(DATA, $DATA_START, 0); LBindex($tab); $txt{$tab}->tagRemove('bold', '1.0', 'end'); $txt{$tab}->GotoLineNumber('1'); $NB[$wn]->pageconfigure($tab, -label=>"HELP"); } sub removetag { my $tab=$_[0]; my @gone = $tag_LB{$tab}->get('anchor','active'); my $anchor = $tag_LB{$tab}->index('anchor'); my $end = $tag_LB{$tab}->index('active'); foreach (@gone) { my @specs = split /(:.)/, $_; my $chars; (my $limit = $specs[0])+=1; my $x=0; if ($specs[1] eq ":*") { while (1) { my @index = $txt{$tab}->tagNextrange('marked', "$specs[0]. + 0", "$limit.0"); unless (defined($index[1])) {return} my $del = $txt{$tab}->get("$index[0]", "$index[1]"); if ($del eq $specs[2] || $x eq $index[0]) { $txt{$tab}->tagRemove('marked', "$index[0]", "$index[1 + ]"); foreach my $X (keys %{$notes{$tab}}) { $X =~ /^X:(\d+)\./; print "remove: $X $specs[0] $1 ${$notes{$tab}}{$X} +

"; if ($1 == $specs[0]) {delete ${$notes{$tab}}{$X}} my $XX = scalar %{$notes{$tab}}; print "remove2: $XX

"; }last} $x=$index[0]; }} else { while (1) { my @index = $txt{$tab}->tagNextrange('hlite', "$specs[0].0 + ", "$limit.0"); unless (defined($index[1])) {return} my $del = $txt{$tab}->get("$index[0]", "$index[1]"); if ($del eq $specs[2] || $x eq $index[0]) { $txt{$tab}->tagRemove('hlite', "$index[0]", "$index[1] + "); $txt{$tab}->tagRemove('bold', "$specs[0].0", "$specs[0 + ].0 lineend"); last} $x=$index[0]; }} } $tag_LB{$tab}->delete($anchor,$end); @tags = $tag_LB{$tab}->get('0','end'); LBindex($tab); } sub savetags { (my $wn=$_[0])=~s/save-//; my $tab=$NB[$wn]->raised(); @tags = $tag_LB{$tab}->get('0','end'); ### retrieve index my @red = $txt{$tab}->tagRanges('red'); unless (defined($tags[0]) || defined($red[0])) {return "nothing to + save"} (my $name="@{$info{$tab}}[1]") =~ s/\//_/; open (TF, ">$CXdir/$name.cdx") || return "can't create $CXdir/$nam + e.cdx"; if (defined($red[0])) {print TF "RED: @red

"} foreach (@tags) {print TF "$_

"} close (TF); my %tmp; unlink "$CXdir/$name.cdx.db"; my $numofnotes = 0; foreach (keys %{$notes{$tab}}) {$numofnotes++} if ($numofnotes > 0) { dbmopen %tmp, "$CXdir/$name.cdx.db", 0666; %tmp=%{$notes{$tab}}; dbmclose %tmp; } if ($WC[$wn] eq "yes") { (my $safe = $name) =~ s/\//_/g; my $content = $txt{$tab}->get('1.0','end'); open (WC, ">$CXdir/$safe.cdx.wc"); print WC "$content"; close (WC); $WC[$wn] = "no"; } $VW[$wn]->title("saved notes for $name"); } sub showloc { (my $name="@_")=~s/^\*+//; if ($name eq "CLEAR") {$loctxt="";return} if (exists($loc{$name})) { $loctxt=""; my @locations = split / /,$loc{$name}; foreach (@locations) { (my $N = $_) =~ s/^..//; $N++; (my $l = $_) =~ s/..$//; $loctxt="$loctxt $N$l"; } } } 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}}")} } 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; @Nray = (); foreach my $name (@dirray) { (my $file=$name) =~ s/^\*+//; open (CXF, "$files{$file}") || next; my $content = do {local $/; <CXF>}; close (CXF); # "do local" reads entire file as one + line 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) { push @Nray, $N_index{$file}; if (exists($loc{$file}) && $loc{$file} =~ /-/) { $_ = "$loc{$file}"; my $x =()= /-/g; my $n=0; until ($n==$x) { $file =~ s/^/\*/; $DLB->activate($i); $n++} } $i++} $MW->title("TkCodex"); } sub unline { my $tab="@_"; (my $lino = $txt{$tab}->index('insert')) =~ s/\.\d+$//; $txt{$tab}->tagRemove('marked', "$lino.0", "$lino.0 lineend"); $txt{$tab}->tagRemove('hlite', "$lino.0", "$lino.0 lineend"); $txt{$tab}->tagRemove('bold', "$lino.0", "$lino.0 lineend"); $txt{$tab}->tagRemove('red', "$lino.0", "$lino.0 lineend"); my $items = $tag_LB{$tab}->size; for (my $i=0; $i<$items; $i++) { my $tag = $tag_LB{$tab}->get($i); if ($tag =~ /^$lino:/) {$tag_LB{$tab}->delete($i)} $items = $tag_LB{$tab}->size; } } sub unlite { (my $n=$_[0])=~s/unlite-//; $instances[$n]=0; my $unexact = $VW_EN[$n]->get(); if ($unexact eq "") {return} my $tab = $NB[$n]->raised(); my $sw="okay"; foreach (@history) {if ($_ eq $unexact) {my $sw="DONE"}} unless ($sw eq "DONE") {push @history, $unexact} $VW_EN[$n]->delete('0','end'); @tags = $tag_LB{$tab}->get('0','end'); my $last = $tag_LB{$tab}->index('end'); my @locked; my @locknum; # retain whited tags for (my $i=0; $i<$last; $i++) { my $value = $tag_LB{$tab}->itemcget("$i", -background); if (defined($value) && $value eq 'white') { my $tagline = $tag_LB{$tab}->get("$i"); push @locked,$tagline; $tagline =~ /^(\d+):/; push @locknum,$1; } } $tag_LB{$tab}->delete('0','end'); # nb. the entire tag list + is erased my $chars=0; # and later regenerated my $start='1'; while (1) { my $x; my $switch = "off"; if ($case eq "nocase" && $RGXP[$n] eq "no") { $x = $txt{$tab}- + >search(-exact,-nocase,"$unexact","$start.0")} elsif ($case eq "case" && $RGXP[$n] eq "no") { $x = $txt{$tab} + ->search(-exact,"$unexact","$start.0")} elsif ($case eq "nocase" && $RGXP[$n] eq "yes") { $x = $txt{$t + ab}->search(-regexp,-nocase,"$unexact","$start.0")} elsif ($case eq "case"&& $RGXP[$n] eq "yes") { $x = $txt{$tab} + ->search(-regexp,"$unexact","$start.0")} if ($x eq "" || $x < $start) {last} my @index = split /\./,$x; foreach (@locknum) { if ($index[0] == $_) { $switch = "on"}} unless ($switch eq "on") { $txt{$tab}->tagRemove('bold',"$index[0].0", "$index[0].0 l + ineend"); $txt{$tab}->tagRemove('hlite',"$index[0].0", "$index[0].0 + lineend"); } ($start=$index[0])+=1; } my @swap; if ($RGXP[$n] eq "no" && $case eq "nocase") { foreach my $elem (@tags) { my @TL = split /(:.)/,$elem,3; unless ($TL[1] eq ": " && $TL[2] eq "$unexact") { push @swap,$elem; } } } elsif ($RGXP[$n] eq "no" && $case eq "case") { foreach my $elem (@tags) { my @TL = split /(:.)/,$elem,3; unless ($TL[1] eq ":^" && $TL[2] eq "$unexact") { push @swap,$elem; } } } elsif ($RGXP[$n] eq "yes" && $case eq "nocase") { foreach my $elem (@tags) { my @TL = split /(:.)/,$elem,3; unless ($TL[1] eq ":~" && $TL[2] eq "$unexact") { push @swap,$elem; } } } elsif ($RGXP[$n] eq "yes" && $case eq "case") { foreach my $elem (@tags) { my @TL = split /(:.)/,$elem,3; unless ($TL[1] eq ":!" && $TL[2] eq "$unexact") { push @swap,$elem; } } } print "@swap

"; foreach (@swap) { my @ln = split /(:.)/,$_,3; unless ($ln[1] eq ":*") {hilite("$tab", "$ln[2]")} } push(@swap,@locked); @tags=@swap; LBindex($tab); } sub unsearch { my $tab = "@_"; (my $wn = $tab) =~ s/^[A-D]-//; $instances[$wn]=0; my $match = $VW_EN[$wn]->get(); unless ($match =~ /\w/) {return "No search criteria!"} if ($case eq "nocase" && $RGXP[$wn] eq "no") {$txt{$tab}->FindAll( + -exact, -nocase, "$match")} elsif ($case eq "case"&& $RGXP[$wn] eq "no") {$txt{$tab}->FindAll( + -exact, -case, "$match")} elsif ($case eq "nocase"&& $RGXP[$wn] eq "yes") {$txt{$tab}->FindA + ll(-regexp, -nocase, "$match")} elsif ($case eq "case"&& $RGXP[$wn] eq "yes") {$txt{$tab}->FindAll + (-regexp, -case, "$match")} my @found = $txt{$tab}->tagRanges('sel'); while (defined($found[0])) { my $begin = shift @found; my $end = shift @found; $txt{$tab}->tagRemove('red', "$begin", "$end"); } $VW[$wn]->title("@{$info{$tab}} ($match) unredded"); foreach my $past (@history) {if ($past eq $match) {return}} push @history, $match; } sub unsubs { (my $wn=$_[0])=~s/^[A-D]-//; my $tab=$NB[$wn]->raised(); + my @donegone; @tags = $tag_LB{$tab}->get('0','end'); foreach my $tag (@tags) { if ($tag =~ /^(\d+): (.+)\{$/) { my $n=$1; my $bit=$2; my $length=length $bit; $txt{$tab}->tagRemove('hlite', "$n.0", "$n.$length"); push @donegone, "$n: $bit"; } } foreach my $bit (@donegone) {@tags=grep { $_ !~ /^$bit/} @tags} $tag_LB{$tab}->delete('0', 'end'); foreach (@tags) {$tag_LB{$tab}->insert('end', "$_")} $VW[$wn]->title("@{$info{$tab}} subrountine highlighting off"); } __DATA__ ______________________________________________________________________ + __________________________ TkCodex Quick Reference ______________________________________________________________________ + __________________________ Command-line parameters (all optional, but the first requires the seco + nd): TkCodex [TREETOP DIRECTORY] [FILENAME EXTENSION] [REGEXP] eg. TkCodex /home/user/scripts c printf or usually just TkCodex /home/ + user/scripts c Note that the filename extension does not include a leading "." and th + e regexp is case-insensitive. If you need a case sensitive search, you will have + to start TkCodex first and check "case". TkCodex uses the titlebar to issue messages and warnings so make sure + this is visible and not restricted somehow by your window manager. There is one small command window and four larger view windows which c + an be made to APPEAR or DISAPPEAR with the first four F-keys, which work the same everywhere i + n TkCodex. The view windows are all invisible on start-up. Windows are generated only once, so if + you use your window manager to "close" one, you won't get it back! This is different from most GU + I apps. Just use F1-4. TkCodex does not use scrollbars, any possible scrolling is done by dra + gging the mouse or using the arrow/page keys. There is also some scrolling with "ctrl" in the + view windows (see Text area Control keys). There is no NECESSARY configuration, however, if you want to create a + fresh, empty directory somewhere for TkCodex to use and enter the path at the beginning of th + e script (line 14) then you gain some functionality (hereafter referred to as the codex-directory) + . About geometry: As is, TkCodex is set up for a 1200 x 800 viewport wi + th window borders exactly the same size as mine -- otherwise, you can fiddle with the geometry s + ettings at line 123 (there is a note about this in the TkCodex.pl.cdx.db file; changing the horiz + ontal width will also require changing some "place" values for the widgets). ________________________________________________________________ TkCodex works recursively using the directory in the top entry of the + command window as its root. The file list is generated at startup if you include a directory AND A + SUFFIX on the command-line. This list is regenerated whenever you press dir. You can maintain a s + imple list of bookmarked directories if you have a codex-directory (the file is tkcodex.bookmar + ks). Within the top entry space, pressing ctrl-a adds the current directory, ctrl-d removes it, + and the up and down arrows will cycle through the existing bookmarks (like the command-history in + bash). Because of recursion, files with the same name in different directorie + s of the tree are given a relative path name after the first one TkCodex finds (which is not nec + essarily the one highest in the tree). Also note that you must use a suffix -- TkCodex will on + ly select files of one flavor at a time ("pl", "sh", "pov", "css", et. al.). If you enter a regular expression in the entry space under the command + window file list and click regexp the contents of the file list box will be sorted according the + regexp's frequency of occurence in each file. The left column will then show the actual number of occ + urences. The regexp in this entry space will now be automatically highlighted in every file you lo + ad. Again, by default all TkCodex searches (regexp or otherwise) are CASE INSENSITIVE. You can + change this by checking "case". A number of asterisks before a file name in the command window list in + dicates the file is loaded in one or more tabs. Clicking the right mouse button on the file name wi + ll show the tab locations(s) in red at the bottom left (2C = the third tab in the second window). Loading files is accomplished by either: 1) keying 1, 2, 3, or 4 (= a number key) in the command window list bo + x while a file is highlighted (the file will appear in the first open tab of that window). 2) pushing 1st 4 in a view window -- the first four files will appear + in the four tabs (A, B, C, D) of that view window only. This will replace all the files in that + window. Files are unloaded one of three ways: 1) by pressing the clear button on a tab that tab will be cleared. 2) by pressing all in a view window all four tabs in the window will c + lear. 3) by pressing CLEARALL in the command window all tabs everywhere will + be cleared. TkCodex does not update from files if they change (remember, they can' + t be changed by TkCodex). I was going to include a "fast reload" button for when working on some + thing in an editor and examining it in TkCodex simultaneously. In the end I didn't because, + although I should be allowed to make my own mistakes like everyone else, I found having that unchan + ged copy available to be saved (as "working copy", see below) handy. Otherwise, I would just get int + o the habit of hitting "reload" every time I add an indent (which is about the frequency at w + hich I save in vim). _____________________________________________________ The Text Display and Highlighting: TkCodex uses a read-only text display. The code you load cannot be al + tered. If the command window file list is the product of a regexp search, that regular expression w + ill be automatically highlighted in all files loaded (clear a search by pressing dir). Thi + s includes an index (by line number) of the highlighted instances. Also, every line containing a h + ighlight is shown bold italic indigo rather than plain black. You can add your own highlights by ty + ping something into the entry space of the view window and then either: 1) pressing hilite 2) pressing ctrl-s to perform a simple search which highlights all ins + tances in bold green without indexing. A ctrl-s search also takes you to the first inst + ance of the string and selects it, which means one mouse click or another will take you to + the next or previous instance (right button = forward, both buttons = back). Only one s + et of green highlights will exist at a time -- the next ctrl-s will replace it. This is s + ame as the traditional "find all" from word processors and web browsers. Multiple searche + s of this type can be done with ctrl-R (see below). Either way, the settings for "case" and "regexp" apply. These are det + ermined by a check button in the command window (case) and check buttons in each view window (regex + p). The default is a case-insensitive, exact (non-regexp) match, so you don't have to type + escape sequences (\$, \\, etc.) etc. However, remember that matches from the command window ent + ry are always regular expressions. If the case button is checked, a big red asterisk appear + s next to the unlite button in all the view windows, meaning all searches and hilites are now case-se + nsitive. See also CAVEAT #2. The entry space of the view window has an automatic history, like bash + . If you use the arrow keys, you can cycle thru your previous search values. This memory is not sa + ved after you quit TkCodex. The unlite button "undoes" a search according to the current case and + regexp settings, including all highlighting and indexing. The case and regexp settings MUST be t + he same for this to work. You can tell how they were set by consulting the tag index list (see b + elow). You can also eliminate an individual highlight with ctrl-a or by using both buttons + on its index in the list. Text area Control keys TkCodex uses ctrl-key macros rather than menus for speed and simplicit + y. They are: ctrl-a removes all highlighting and indexing on the current line (ex + cept green ones) ctrl-h will call this "Quick Reference" into the tab if it is E M P + T Y ctrl-c will give the exact character position of the cursor in red a + t the bottom right corner (which usually just provides the line number). Note that the + first character is 0, not 1. ctrl-f undoes the result of a ctrl-R search. ctrl-g will goto the line number in the view window's entry box, rep + lacing it with your previous position to facilitate quick back and forth movements. Eg, if you + type "666" while you are on line 27 in the entry and press ctrl-g in the text area, you go + to line 666 and "666" is replaced with "27" in the entry, which means ctrl-g again will ta + ke you back to 27. ctrl-G will return you to your position previous to the last move ma + de via clicking on an index in the tag list, or back to that index after you use ctrl-G (get + it...) ctrl-i scrolls the text area up one line without moving the cursor ( + PgUp, etc. work normally). ctrl-k scrolls the text area down one line without moving the cursor + . ctrl-l scrolls the tag index list down one line. ctrl-m adds a hyper-text style note to the selected text and indexes + it. This mark is arbitrarily limited to 27 characters (see marknote() in the sourc + e script). Such marks are reverse highlighted. You can view them by ctrl-left clicking + with the cursor on the mark itself. The "note" window only has one button (done). + Pressing it saves the content of the note for that mark and withdraws the window. To w + ithdraw the window without saving any changes, use ctrl-c. ctrl-r highlights the selected text bold red. This is not indexed, + but if you save a .cdx file for the code, red highlights will be saved along with the indexed + ones. ctrl-R does the same as ctrl-s, except all instances are bold red, s + o they won't disappear when you do another non-indexed "find all" search, and will be saved r + ed. Undo a ctrl-R with ctrl-f. ctrl-s performs a traditional, non-indexed "find all" in bold green. + To go to the "next" instance right click the mouse, to go to the "previous" instance use both + buttons (see CAVEAT #3). ctrl-S highlights and indexes ALL perl subroutines if they have the + form sub NAME { (which is the normative "best practice"). ctrl-S is undone with ctrl-U. ctrl-v will send the current line to vim via "vim --remote" (vim mus + t be compiled with such functionality, it may not be by default). Because the line must + pass through the shell in single quotes, single quotes (') in the line are replaced with do + uble asterisks (**). Generally, you need to be in vim's INSERT mode for this to be use + ful. ctrl-u removes bold red from the selected text. This is to allow yo + u to remove the red without removing any highlights it may overlap. ctrl-U turns perl subroutine highlighting off. ctrl-9 SUBTRACT one from the tag index (see below). If you type a n + umber in the view window text entry, subtract that number instead. This only affects tags belo + w the cursor position. ctrl-0 (ctrl-zero) ADD one or more to the tag index line numbers bel + ow the cursor. The Tag Index List Tagging is the essence of TkCodex and existing "tags" or highlights ar + e indexed by line number in a listbox on the right side of each notebook tab. Right-clicking on an + entry will center that line in the text area. The index also indicates the "flavor" of the tag (whet + her it was produced by a regular expression search, a case sensitive search, et. al.) with a si + ngle character between the line number and the tag pattern. Normally this is just a space, indic + ating the tag is the product of an exact, case-insensitive hilite search (the default). But it cou + ld also be: ^ indicating a case-sensitive exact search ~ indicating a (case insensitive) regular expression search ! indicating a case-sensitive regular expression search * indicating a hypertext style ctrl-m note Pressing both buttons (or "button 3") on a tag (or range of tags) in t + he list will remove it/them from the list and the corresponding highlight(s) from the text. Also, + you can select a tag (or range) using ctrl-left click, turning the background white. Those tag + s will then be EXCLUDED from the next unlite. TkCodex will not "update" the position of a tag if you save the tag li + st and the file changes. Since working on a script usually means adding and removing lines, you + can automatically decrement or increment the line number index of all or some of the tags by posit + ioning the cursor in the text area and hitting ctrl-9 or ctrl-0 (perl/Tk does not accept "-" or "+" + as keysyms in ROtext). All tags in the listbox beyond the current line number are affected. You can eliminate ALL tags with the tags button. .cdx and .cdx.db files The tag list and its associated notes and highlights, as well as unind + exed red bold bits, can all be saved for application to the same code again if you have a codex-direc + tory. This is done via the save and load buttons. TkCodex simply saves a text file with the scri + pt short name being used plus the extension ".cdx". This may create a problem if you access a tree + containing identical filenames at different points at different times -- eg. if you sometimes use "/h + ome/user/scripts" and sometimes "/home/user/scripts/perl" and there are two files named "program.pl" i + n the first tree but not in the second (which is contained in the first, obviously) then TkCodex may g + et confused. See also CAVEAT #4. The .cdx text file contains instructions for highlighting a piece of c + ode but no code itself. If you added hypertext style ctrl-m notes to a file there will also be a + binary database file, "program.pl.cdx.db". Both are saved and loaded at the same time. If + you want to have different mark-up files for the same piece of code, you will have to swap these + in and out of the codex-directory because the the selection is automatic -- you don't ha + ve to pick a name or look for anything when you hit load or save. The working copy checkbutton enables you to save a copy of the script + itself along with the mark-up instructions. This may be useful if you are worried about keeping not + es during revision, and also gives you a quick way of undoing changes made in an editor, since what + is saved is the code in the text area. This working copy IS NOT saved in the original script loca + tion, it's saved in the codex-directory with the extension ".cdx.wc". Once again, TkCodex doe + s not contain the potential to overwrite (or write) any file outside the codex-directory. If the wor + king copy button is checked when you press load, the script in the text area will be replaced with + its working copy and the associated mark-up. Exit TkCodex with ctrl-Q. CAVEATS: 1) removing a tag in the listbox MAY affect all the tags with the same + line number. 2) Due to an obvious oversight, if you begin an exact search in perl/T + k with the dash character ("-"), the search criteria is mistaken for a switch -- eg. "->index" won't + work (and actually produces a stderr message) whereas ">index" is fine, and the regexp "\->index" + also fine. Searching for a real switch (eg, "-count") produces a weirder error. So use regexp + with searches starting "-". 3) "Both buttons" means button 3 if you have a three button mouse... 4) Technically, when TkCodex includes a relative path in the name of a + file because of multiples, such a file's .cdx will be saved with "_" substituting for "/". eg., "ht + ml_page.html.cdx". !!!RED: 2.4 2.27 37.44 37.47 39.16 39.22 39.51 39.57 48.0 48.6 60.11 6 + 0.16 64.19 64.25 65.15 65.18 !!!RED: 66.15 66.23 79.30 79.36 80.60 80.63 84.12 84.18 85.12 85.18 86 + .24 86.30 89.36 89.42 91.8 91.14 !!!RED: 94.20 94.24 94.65 94.72 97.84 97.90 103.4 103.10 104.36 104.40 + 104.45 104.51 111.1 111.7 112.1 112.7 !!!RED: 113.1 113.7 106.39 106.45 115.32 115.38 115.1 115.7 116.1 116. + 7 118.36 118.42 119.47 119.53 120.1 120.7 !!!RED: 121.55 121.61 122.1 122.7 123.1 123.7 124.1 124.7 125.1 125.7 + 128.59 128.63 130.34 130.40 131.1 131.7 !!!RED: 131.38 131.46 133.1 133.7 133.26 133.32 134.79 134.85 135.2 13 + 5.8 136.1 136.7 138.1 138.7 139.52 139.58 !!!RED: 139.74 139.80 140.1 140.7 144.1 144.7 144.17 144.25 146.1 146. + 7 147.1 147.7 149.1 149.7 157.30 157.36 !!!RED: 162.31 162.37 180.0 180.4 180.9 180.13 192.22 192.26 192.30 19 + 2.34 200.15 200.19 210.64 210.70 !!!RED: 167.9 167.5 172.17 172.23 172.27 172.33 203.18 203.24 167.9 16 + 7.15 175.36 175.39 188.26 188.32 !!!GREEN: 85.80 85.91 111.75 111.85 136.59 136.69 !!!BOLD: 6.0 6.58 15.19 15.34 15.50 15.63 21.88 22.12 26.54 26.69 38.5 + 5 38.72 44.30 44.51 86.3 86.20 98.89 98.98 !!!BOLD: 104.61 104.65 105.49 105.63 106.39 106.35 112.64 112.73 137.8 + 0 137.89 147.31 147.40 138.75 138.85 !!!BOLD: 156.34 156.64 159.0 159.1 160.0 160.1 161.0 161.1 162.0 162.1 + 166.13 166.28 185.0 185.9 194.4 194.16 !!!IT: 7.4 7.40 7.56 7.86 36.38 36.40 38.12 38.14 43.19 43.24 96.73 97 + .11 104.32 104.35 104.41 104.44 104.52 104.60 !!!IT: 104.66 104.99 114.57 114.99 122.43 122.68 141.45 142.87 147.55 + 148.60 159.15 159.35 160.34 160.52 !!!IT: 161.15 161.48 179.45 179.47 !!!BII: 81.88 82.6 !!!REV: 127.6 127.25 +++5: Command-line parameters +++28: About geometry +++57: Loading files +++77: Highlighting +++108: Text area Control keys +++151: Tag Index List +++177: .cdx and .cdx.db files +++205: CAVEATS