Upgrade to podlators-2.00
[p5sagit/p5-mst-13.2.git] / lib / Pod / Text / Termcap.pm
CommitLineData
6055f9d4 1# Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes.
b7ae008f 2# $Id: Termcap.pm,v 2.1 2004/12/31 21:50:00 eagle Exp $
6055f9d4 3#
b7ae008f 4# Copyright 1999, 2001, 2002, 2004 by Russ Allbery <rra@stanford.edu>
6055f9d4 5#
3c014959 6# This program is free software; you may redistribute it and/or modify it
6055f9d4 7# under the same terms as Perl itself.
8#
9741dab0 9# This is a simple subclass of Pod::Text that overrides a few key methods to
3c014959 10# output the right termcap escape sequences for formatted text on the current
11# terminal type.
6055f9d4 12
3c014959 13##############################################################################
6055f9d4 14# Modules and declarations
3c014959 15##############################################################################
6055f9d4 16
17package Pod::Text::Termcap;
18
19require 5.004;
20
21use Pod::Text ();
22use POSIX ();
23use Term::Cap;
9741dab0 24
6055f9d4 25use strict;
26use vars qw(@ISA $VERSION);
27
28@ISA = qw(Pod::Text);
29
3c014959 30# Don't use the CVS revision as the version, since this module is also in Perl
31# core and too many things could munge CVS magic revision strings. This
32# number should ideally be the same as the CVS revision in podlators, however.
b7ae008f 33$VERSION = 2.01;
6055f9d4 34
3c014959 35##############################################################################
6055f9d4 36# Overrides
3c014959 37##############################################################################
6055f9d4 38
39# In the initialization method, grab our terminal characteristics as well as
40# do all the stuff we normally do.
b7ae008f 41sub new {
42 my ($self, @args) = @_;
a97e9142 43 my ($ospeed, $term, $termios);
b7ae008f 44 $self = $self->SUPER::new (@args);
6055f9d4 45
2ccddc90 46 # $ENV{HOME} is usually not set on Windows. The default Term::Cap path
47 # may not work on Solaris.
8bafa735 48 my $home = exists $ENV{HOME} ? "$ENV{HOME}/.termcap:" : '';
49 $ENV{TERMPATH} = $home . '/etc/termcap:/usr/share/misc/termcap'
50 . ':/usr/share/lib/termcap';
6055f9d4 51
a97e9142 52 # Fall back on a hard-coded terminal speed if POSIX::Termios isn't
4989cd70 53 # available (such as on VMS).
a97e9142 54 eval { $termios = POSIX::Termios->new };
55 if ($@) {
2da3dd12 56 $ospeed = 9600;
a97e9142 57 } else {
58 $termios->getattr;
2da3dd12 59 $ospeed = $termios->getospeed || 9600;
8ef7c2e5 60 }
a97e9142 61
62 # Fall back on the ANSI escape sequences if Term::Cap doesn't work.
b4558dc4 63 eval { $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed } };
64 $$self{BOLD} = $$term{_md} || "\e[1m";
65 $$self{UNDL} = $$term{_us} || "\e[4m";
66 $$self{NORM} = $$term{_me} || "\e[m";
6055f9d4 67
68 unless (defined $$self{width}) {
b7ae008f 69 $$self{opt_width} = $ENV{COLUMNS} || $$term{_co} || 80;
70 $$self{opt_width} -= 2;
6055f9d4 71 }
72
b7ae008f 73 return $self;
6055f9d4 74}
75
76# Make level one headings bold.
77sub cmd_head1 {
b7ae008f 78 my ($self, $attrs, $text) = @_;
79 $text =~ s/\s+$//;
80 $self->SUPER::cmd_head1 ($attrs, "$$self{BOLD}$text$$self{NORM}");
6055f9d4 81}
82
83# Make level two headings bold.
84sub cmd_head2 {
b7ae008f 85 my ($self, $attrs, $text) = @_;
86 $text =~ s/\s+$//;
87 $self->SUPER::cmd_head2 ($attrs, "$$self{BOLD}$text$$self{NORM}");
6055f9d4 88}
89
90# Fix up B<> and I<>. Note that we intentionally don't do F<>.
b7ae008f 91sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" }
92sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" }
6055f9d4 93
59548eca 94# Output any included code in bold.
95sub output_code {
96 my ($self, $code) = @_;
97 $self->output ($$self{BOLD} . $code . $$self{NORM});
98}
99
6055f9d4 100# Override the wrapping code to igore the special sequences.
101sub wrap {
102 my $self = shift;
103 local $_ = shift;
104 my $output = '';
105 my $spaces = ' ' x $$self{MARGIN};
b7ae008f 106 my $width = $$self{opt_width} - $$self{MARGIN};
107
108 # $codes matches a single special sequence. $char matches any number of
109 # special sequences preceeding a single character other than a newline.
110 my $codes = "(?:\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)";
111 my $char = "(?:$codes*[^\\n])";
6055f9d4 112 while (length > $width) {
b7ae008f 113 if (s/^(${char}{0,$width})\s+// || s/^(${char}{$width})//) {
6055f9d4 114 $output .= $spaces . $1 . "\n";
115 } else {
116 last;
117 }
118 }
119 $output .= $spaces . $_;
120 $output =~ s/\s+$/\n\n/;
b7ae008f 121 return $output;
6055f9d4 122}
123
3c014959 124##############################################################################
6055f9d4 125# Module return value and documentation
3c014959 126##############################################################################
6055f9d4 127
1281;
129__END__
130
131=head1 NAME
132
fd20da51 133Pod::Text::Termcap - Convert POD data to ASCII text with format escapes
6055f9d4 134
135=head1 SYNOPSIS
136
137 use Pod::Text::Termcap;
138 my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78);
139
140 # Read POD from STDIN and write to STDOUT.
141 $parser->parse_from_filehandle;
142
143 # Read POD from file.pod and write to file.txt.
144 $parser->parse_from_file ('file.pod', 'file.txt');
145
146=head1 DESCRIPTION
147
9741dab0 148Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output
149text using the correct termcap escape sequences for the current terminal.
150Apart from the format codes, it in all ways functions like Pod::Text. See
151L<Pod::Text> for details and available options.
6055f9d4 152
b84d8b9e 153=head1 NOTES
b4558dc4 154
155This module uses Term::Cap to retrieve the formatting escape sequences for
156the current terminal, and falls back on the ECMA-48 (the same in this
157regard as ANSI X3.64 and ISO 6429, the escape codes also used by DEC VT100
158terminals) if the bold, underline, and reset codes aren't set in the
159termcap information.
160
6055f9d4 161=head1 SEE ALSO
162
b7ae008f 163L<Pod::Text>, L<Pod::Simple>, L<Term::Cap>
6055f9d4 164
fd20da51 165The current version of this module is always available from its web site at
166L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the
167Perl core distribution as of 5.6.0.
168
6055f9d4 169=head1 AUTHOR
170
3c014959 171Russ Allbery <rra@stanford.edu>.
172
173=head1 COPYRIGHT AND LICENSE
174
b7ae008f 175Copyright 1999, 2001, 2002, 2004 by Russ Allbery <rra@stanford.edu>.
3c014959 176
177This program is free software; you may redistribute it and/or modify it
178under the same terms as Perl itself.
6055f9d4 179
180=cut