File: tkperldoc

package info (click to toggle)
perl-tk 1:800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (75 lines) | stat: -rwxr-xr-x 1,664 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
#!/usr/local/bin/perl -w

use strict;
use Tk;
use Tk::ROText;
use Tk::Font;
use Carp;

my $mw = MainWindow->new;
my $mfont     = $mw->Font(family => 'courier', slant => 'r', point => 140, weight  => 'medium');
my $bfont     = $mfont->Clone(weight  => 'bold');
my $t         = $mw->Scrolled('ROText',-font => $mfont, -wrap => 'none');
$t->Tag('bold',-font => $bfont);
$t->Tag('underline',-underline => 1);

$t->pack(-expand => 1, -fill => 'both');

# Netscape/Mosaic like paging 
$t->bind('<space>',['yview','scroll',1,'page']);
$t->bind('<BackSpace>',['yview','scroll',-1,'page']);

@ARGV = qw(perl) unless (@ARGV);

load_doc($t,@ARGV);

$mw->focusNext;

MainLoop;

sub load_doc
{
  my $t = shift;
  open(PIPE,join(' ','perldoc',@_,'|')) || die "Cannot open pipe:$!";
  $t->delete('1.0' => 'end');
  $t->insert('end','');
  while (<PIPE>)
   {          
    my $line  = "";
    my @bold  = ();
    my @under = (); 
    while (length($_))
     {        
      if (s/^(\n)//)
       {      
        $t->insert('end',$1);
        $t->markSet(insert => 'end');
       }      
      elsif (s/^_\010(.)//)
       {      
        $t->insert('insert',$1,['underline']);
       }      
      elsif (s/^([^\010])(\010\1)+//)
       {      
        $t->insert('insert',$1,['bold']);
       }      
      elsif (s/^\+\010o//)
       {      
        $t->insert('insert','o',['bold']);
       }      
      elsif (s/^(\010+)//)
       {     
#       my $offset = length($1);
#       $t->markSet(insert => "insert - $offset c");
       }     
      elsif (s/^(.)//)
       {      
        $t->insert('insert',$1);
       }      
     }        
   }          
  close(PIPE);

}