line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Pod::Dsr -- Convert POD data to formatted Digital Standard Runoff input. |
2
|
|
|
|
|
|
|
# $Id: Dsr.pm,v 0.01 2001/01/16 13:39:45 pvhp Exp $ |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Copyright 2001 by Peter Prymmer |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify it |
7
|
|
|
|
|
|
|
# under the same terms as Perl itself. |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# This module uses Pod::Parser and is designed to be easy |
10
|
|
|
|
|
|
|
# to subclass. |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
# Based upon: Pod::Man 1.14 by Russ Allbery |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
############################################################################ |
15
|
|
|
|
|
|
|
# Modules and declarations |
16
|
|
|
|
|
|
|
############################################################################ |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
package Pod::Dsr; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
require 5.004; |
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
1
|
|
930
|
use Carp qw(carp croak); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
79
|
|
23
|
1
|
|
|
1
|
|
5
|
use Pod::Parser (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
28
|
|
26
|
1
|
|
|
1
|
|
964
|
use subs qw(makespace); |
|
1
|
|
|
|
|
28
|
|
|
1
|
|
|
|
|
5
|
|
27
|
1
|
|
|
1
|
|
48
|
use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
14451
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
@ISA = qw(Pod::Parser); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Don't use the CVS revision as the version, since this module is also in |
32
|
|
|
|
|
|
|
# Perl core and too many things could munge CVS magic revision strings. |
33
|
|
|
|
|
|
|
# This number should ideally be the same as the CVS revision in podlators, |
34
|
|
|
|
|
|
|
# however. |
35
|
|
|
|
|
|
|
$VERSION = 0.01; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
############################################################################ |
39
|
|
|
|
|
|
|
# Preamble and *roff output tables |
40
|
|
|
|
|
|
|
############################################################################ |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# The following is the static preamble which starts all dsr output we |
43
|
|
|
|
|
|
|
# generate. It's completely static except for the .LAYOUT to use, |
44
|
|
|
|
|
|
|
# designated by @LAYOUT@. Hence, $PREAMBLE should therefore be run |
45
|
|
|
|
|
|
|
# through s/\@LAYOUT\@/.LAYOUT $n1,$n2/g before output. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
$PREAMBLE = <<'----END OF PREAMBLE----'; |
48
|
|
|
|
|
|
|
@LAYOUT@ |
49
|
|
|
|
|
|
|
.! We need .CONTROL CHARACTERS in order to accept 255 (also 0-31,127-159). |
50
|
|
|
|
|
|
|
.CONTROL CHARACTERS |
51
|
|
|
|
|
|
|
.! The % character can often appear in documentation. |
52
|
|
|
|
|
|
|
.DISABLE OVERSTRIKING |
53
|
|
|
|
|
|
|
.! Turn on ^*bold\* recognition |
54
|
|
|
|
|
|
|
.FLAGS BOLD |
55
|
|
|
|
|
|
|
.! and ^&underlining\& (for italics) |
56
|
|
|
|
|
|
|
.FLAGS UNDERLINE |
57
|
|
|
|
|
|
|
----END OF PREAMBLE---- |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# This table is adapted from Tom Christiansen's pod2man. It |
60
|
|
|
|
|
|
|
# assumes that _ can be used as the accept character, and that |
61
|
|
|
|
|
|
|
# eight bit Latin-1 characters (derived from the DEC Multnational |
62
|
|
|
|
|
|
|
# Character Set) are acceptable to your version of runoff. |
63
|
|
|
|
|
|
|
%ESCAPES = ( |
64
|
|
|
|
|
|
|
'amp' => '_&', # ampersand |
65
|
|
|
|
|
|
|
'lt' => '_<', # left chevron "angle bracket", less-than |
66
|
|
|
|
|
|
|
'gt' => '_>', # right chevron "angle bracket", greater-than |
67
|
|
|
|
|
|
|
'quot' => '"', # double quotation mark |
68
|
|
|
|
|
|
|
'sol' => '/', # solidus (forward slash) |
69
|
|
|
|
|
|
|
'verbar' => '_|', # vertical bar |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
'Aacute' => 'Á', # capital A, acute accent |
72
|
|
|
|
|
|
|
'aacute' => 'á', # small a, acute accent |
73
|
|
|
|
|
|
|
'Acirc' => 'Â', # capital A, circumflex accent |
74
|
|
|
|
|
|
|
'acirc' => 'â', # small a, circumflex accent |
75
|
|
|
|
|
|
|
'AElig' => 'Æ', # capital AE diphthong (ligature) |
76
|
|
|
|
|
|
|
'aelig' => 'æ', # small ae diphthong (ligature) |
77
|
|
|
|
|
|
|
'Agrave' => 'À', # capital A, grave accent |
78
|
|
|
|
|
|
|
'agrave' => 'à', # small a, grave accent |
79
|
|
|
|
|
|
|
'Aring' => 'Å', # capital A, ring |
80
|
|
|
|
|
|
|
'aring' => 'å', # small a, ring |
81
|
|
|
|
|
|
|
'Atilde' => 'Ã', # capital A, tilde |
82
|
|
|
|
|
|
|
'atilde' => 'ã', # small a, tilde |
83
|
|
|
|
|
|
|
'Auml' => 'Ä', # capital A, dieresis or umlaut mark |
84
|
|
|
|
|
|
|
'auml' => 'ä', # small a, dieresis or umlaut mark |
85
|
|
|
|
|
|
|
'Ccedil' => 'Ç', # capital C, cedilla |
86
|
|
|
|
|
|
|
'ccedil' => 'ç', # small c, cedilla |
87
|
|
|
|
|
|
|
'Eacute' => 'É', # capital E, acute accent |
88
|
|
|
|
|
|
|
'eacute' => 'é', # small e, acute accent |
89
|
|
|
|
|
|
|
'Ecirc' => 'Ê', # capital E, circumflex accent |
90
|
|
|
|
|
|
|
'ecirc' => 'ê', # small e, circumflex accent |
91
|
|
|
|
|
|
|
'Egrave' => 'È', # capital E, grave accent |
92
|
|
|
|
|
|
|
'egrave' => 'è', # small e, grave accent |
93
|
|
|
|
|
|
|
'ETH' => 'Ð', # capital Eth, Icelandic |
94
|
|
|
|
|
|
|
'eth' => 'ð', # small eth, Icelandic |
95
|
|
|
|
|
|
|
'Euml' => 'Ë', # capital E, dieresis or umlaut mark |
96
|
|
|
|
|
|
|
'euml' => 'ë', # small e, dieresis or umlaut mark |
97
|
|
|
|
|
|
|
'Iacute' => 'Í', # capital I, acute accent |
98
|
|
|
|
|
|
|
'iacute' => 'í', # small i, acute accent |
99
|
|
|
|
|
|
|
'Icirc' => 'Î', # capital I, circumflex accent |
100
|
|
|
|
|
|
|
'icirc' => 'î', # small i, circumflex accent |
101
|
|
|
|
|
|
|
'Igrave' => 'Ì', # capital I, grave accent |
102
|
|
|
|
|
|
|
'igrave' => 'ì', # small i, grave accent |
103
|
|
|
|
|
|
|
'Iuml' => 'Ï', # capital I, dieresis or umlaut mark |
104
|
|
|
|
|
|
|
'iuml' => 'ï', # small i, dieresis or umlaut mark |
105
|
|
|
|
|
|
|
'Ntilde' => 'Ñ', # capital N, tilde |
106
|
|
|
|
|
|
|
'ntilde' => 'ñ', # small n, tilde |
107
|
|
|
|
|
|
|
'Oacute' => 'Ó', # capital O, acute accent |
108
|
|
|
|
|
|
|
'oacute' => 'ó', # small o, acute accent |
109
|
|
|
|
|
|
|
'Ocirc' => 'Ô', # capital O, circumflex accent |
110
|
|
|
|
|
|
|
'ocirc' => 'ô', # small o, circumflex accent |
111
|
|
|
|
|
|
|
'Ograve' => 'Ò', # capital O, grave accent |
112
|
|
|
|
|
|
|
'ograve' => 'ò', # small o, grave accent |
113
|
|
|
|
|
|
|
'Oslash' => 'Ø', # capital O, slash |
114
|
|
|
|
|
|
|
'oslash' => 'ø', # small o, slash |
115
|
|
|
|
|
|
|
'Otilde' => 'Õ', # capital O, tilde |
116
|
|
|
|
|
|
|
'otilde' => 'õ', # small o, tilde |
117
|
|
|
|
|
|
|
'Ouml' => 'Ö', # capital O, dieresis or umlaut mark |
118
|
|
|
|
|
|
|
'ouml' => 'ö', # small o, dieresis or umlaut mark |
119
|
|
|
|
|
|
|
'szlig' => 'ß', # small sharp s, German (sz ligature) |
120
|
|
|
|
|
|
|
'THORN' => 'Þ', # capital THORN, Icelandic |
121
|
|
|
|
|
|
|
'thorn' => 'þ', # small thorn, Icelandic |
122
|
|
|
|
|
|
|
'Uacute' => 'Ú', # capital U, acute accent |
123
|
|
|
|
|
|
|
'uacute' => 'ú', # small u, acute accent |
124
|
|
|
|
|
|
|
'Ucirc' => 'Û', # capital U, circumflex accent |
125
|
|
|
|
|
|
|
'ucirc' => 'û', # small u, circumflex accent |
126
|
|
|
|
|
|
|
'Ugrave' => 'Ù', # capital U, grave accent |
127
|
|
|
|
|
|
|
'ugrave' => 'ù', # small u, grave accent |
128
|
|
|
|
|
|
|
'Uuml' => 'Ü', # capital U, dieresis or umlaut mark |
129
|
|
|
|
|
|
|
'uuml' => 'ü', # small u, dieresis or umlaut mark |
130
|
|
|
|
|
|
|
'Yacute' => 'Ý', # capital Y, acute accent |
131
|
|
|
|
|
|
|
'yacute' => 'ý', # small y, acute accent |
132
|
|
|
|
|
|
|
'yuml' => 'ÿ', # small y, dieresis or umlaut mark |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
############################################################################ |
137
|
|
|
|
|
|
|
# Static helper functions |
138
|
|
|
|
|
|
|
############################################################################ |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# Protect leading periods against interpretation as commands. |
141
|
|
|
|
|
|
|
# Also protect flags: |
142
|
|
|
|
|
|
|
# _ Accept |
143
|
|
|
|
|
|
|
# * Bold |
144
|
|
|
|
|
|
|
# | Break |
145
|
|
|
|
|
|
|
# < Capitolize |
146
|
|
|
|
|
|
|
# ! Comment |
147
|
|
|
|
|
|
|
# . Control, DSR command |
148
|
|
|
|
|
|
|
# = Hyphenate |
149
|
|
|
|
|
|
|
# > Index |
150
|
|
|
|
|
|
|
# \ Lowercase |
151
|
|
|
|
|
|
|
# % Overstrike |
152
|
|
|
|
|
|
|
# + Period |
153
|
|
|
|
|
|
|
# # Space |
154
|
|
|
|
|
|
|
# > Subindex |
155
|
|
|
|
|
|
|
# $$ Substitute |
156
|
|
|
|
|
|
|
# & Underline |
157
|
|
|
|
|
|
|
# ^ Uppercase next char |
158
|
|
|
|
|
|
|
sub protect { |
159
|
0
|
|
|
0
|
0
|
|
local $_ = shift; |
160
|
|
|
|
|
|
|
# s/^([.\*\|\\\\%+\#\^])/_$1/mg; |
161
|
0
|
|
|
|
|
|
s/^([.])/_$1/mg; |
162
|
0
|
|
|
|
|
|
$_; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Translate a font string into an escape. |
166
|
|
|
|
|
|
|
sub toescape { |
167
|
|
|
|
|
|
|
# (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] |
168
|
0
|
|
|
0
|
0
|
|
return(@_); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
############################################################################ |
173
|
|
|
|
|
|
|
# Initialization |
174
|
|
|
|
|
|
|
############################################################################ |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Initialize the object. Here, we also process any additional options |
177
|
|
|
|
|
|
|
# passed to the constructor or set up defaults if none were given. center |
178
|
|
|
|
|
|
|
# is the centered title, release is the version number, and date is the date |
179
|
|
|
|
|
|
|
# for the documentation. Note that we can't know what file name we're |
180
|
|
|
|
|
|
|
# processing due to the architecture of Pod::Parser, so that *has* to either |
181
|
|
|
|
|
|
|
# be passed to the constructor or set separately with Pod::Dsr::name(). |
182
|
|
|
|
|
|
|
sub initialize { |
183
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Figure out the fixed-width font. If user-supplied, make sure that |
186
|
|
|
|
|
|
|
# they are the right length. |
187
|
0
|
|
|
|
|
|
for (qw/chapter layout fixed fixedbold fixeditalic fixedbolditalic/) { |
188
|
0
|
0
|
|
|
|
|
if (defined $$self{$_}) { |
189
|
0
|
0
|
0
|
|
|
|
if (length ($$self{$_}) < 1 || length ($$self{$_}) > 2) { |
190
|
|
|
|
|
|
|
# croak qq(roff font should be 1 or 2 chars,) |
191
|
|
|
|
|
|
|
# . qq( not "$$self{$_}"); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
} else { |
194
|
0
|
|
|
|
|
|
$$self{$_} = ''; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# Set the default .LAYOUT. |
199
|
0
|
|
0
|
|
|
|
$$self{layout} ||= '.LAYOUT 0'; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# Set the default .CHAPTER. |
202
|
|
|
|
|
|
|
# $$self{chapter} ||= ''; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Set the default fonts. We can't be sure what fixed bold-italic is |
205
|
|
|
|
|
|
|
# going to be called, so default to just bold. |
206
|
0
|
|
0
|
|
|
|
$$self{fixed} ||= 'CW'; |
207
|
0
|
|
0
|
|
|
|
$$self{fixedbold} ||= 'CB'; |
208
|
0
|
|
0
|
|
|
|
$$self{fixeditalic} ||= 'CI'; |
209
|
0
|
|
0
|
|
|
|
$$self{fixedbolditalic} ||= 'CB'; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# Set up a table of font escapes. First number is fixed-width, second |
212
|
|
|
|
|
|
|
# is bold, third is italic. |
213
|
0
|
|
|
|
|
|
$$self{FONTS} = { '000' => '\fR', '001' => '\fI', |
214
|
|
|
|
|
|
|
'010' => '\fB', '011' => '\f(BI', |
215
|
|
|
|
|
|
|
'100' => toescape ($$self{fixed}), |
216
|
|
|
|
|
|
|
'101' => toescape ($$self{fixeditalic}), |
217
|
|
|
|
|
|
|
'110' => toescape ($$self{fixedbold}), |
218
|
|
|
|
|
|
|
'111' => toescape ($$self{fixedbolditalic})}; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# Extra stuff for page titles. |
221
|
0
|
0
|
|
|
|
|
$$self{center} = 'User Contributed Perl Documentation' |
222
|
|
|
|
|
|
|
unless defined $$self{center}; |
223
|
0
|
0
|
|
|
|
|
$$self{indent} = 4 unless defined $$self{indent}; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# We used to try first to get the version number from a local binary, |
226
|
|
|
|
|
|
|
# but we shouldn't need that any more. Get the version from the running |
227
|
|
|
|
|
|
|
# Perl. Work a little magic to handle subversions correctly under both |
228
|
|
|
|
|
|
|
# the pre-5.6 and the post-5.6 version numbering schemes. |
229
|
0
|
0
|
|
|
|
|
if (!defined $$self{release}) { |
230
|
0
|
|
|
|
|
|
my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); |
231
|
0
|
|
0
|
|
|
|
$version[2] ||= 0; |
232
|
0
|
|
|
|
|
|
$version[2] *= 10 ** (3 - length $version[2]); |
233
|
0
|
|
|
|
|
|
for (@version) { $_ += 0 } |
|
0
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
$$self{release} = 'perl v' . join ('.', @version); |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# Double quotes in things that will be quoted. |
238
|
|
|
|
|
|
|
#for (qw/center date release/) { |
239
|
|
|
|
|
|
|
# $$self{$_} =~ s/\"/\"\"/g if $$self{$_}; |
240
|
|
|
|
|
|
|
#} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Figure out what quotes we'll be using for C<> text. |
243
|
0
|
|
0
|
|
|
|
$$self{quotes} ||= '"'; |
244
|
0
|
0
|
0
|
|
|
|
if ($$self{quotes} eq 'none') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
245
|
0
|
|
|
|
|
|
$$self{LQUOTE} = $$self{RQUOTE} = ''; |
246
|
|
|
|
|
|
|
} elsif (length ($$self{quotes}) == 1) { |
247
|
0
|
|
|
|
|
|
$$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes}; |
248
|
|
|
|
|
|
|
} elsif ($$self{quotes} =~ /^(.)(.)$/ |
249
|
|
|
|
|
|
|
|| $$self{quotes} =~ /^(..)(..)$/) { |
250
|
0
|
|
|
|
|
|
$$self{LQUOTE} = $1; |
251
|
0
|
|
|
|
|
|
$$self{RQUOTE} = $2; |
252
|
|
|
|
|
|
|
} else { |
253
|
0
|
|
|
|
|
|
croak qq(Invalid quote specification "$$self{quotes}"); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Double the first quote; note that this should not be s///g as two |
257
|
|
|
|
|
|
|
# double quotes is represented in *roff as three double quotes, not |
258
|
|
|
|
|
|
|
# four. Weird, I know. |
259
|
0
|
|
|
|
|
|
$$self{LQUOTE} =~ s/\"/\"\"/; |
260
|
0
|
|
|
|
|
|
$$self{RQUOTE} =~ s/\"/\"\"/; |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
$$self{INDENT} = 0; # Current indentation level. |
263
|
0
|
|
|
|
|
|
$$self{INDENTS} = []; # Stack of indentations. |
264
|
0
|
|
|
|
|
|
$$self{INDEX} = []; # Index keys waiting to be printed. |
265
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; # The number of consecutive =items. |
266
|
|
|
|
|
|
|
|
267
|
0
|
|
|
|
|
|
$self->SUPER::initialize; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# For each document we process, output the preamble first. |
271
|
|
|
|
|
|
|
sub begin_pod { |
272
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Try to figure out the name and section from the file name. |
275
|
0
|
|
0
|
|
|
|
my $section = $$self{section} || 1; |
276
|
0
|
|
|
|
|
|
my $name = $$self{name}; |
277
|
0
|
0
|
|
|
|
|
if (!defined $name) { |
278
|
0
|
|
|
|
|
|
$name = $self->input_file; |
279
|
0
|
0
|
0
|
|
|
|
$section = 3 if (!$$self{section} && $name =~ /\.pm\z/i); |
280
|
0
|
|
|
|
|
|
$name =~ s/\.p(od|[lm])\z//i; |
281
|
0
|
0
|
|
|
|
|
if ($section =~ /^1/) { |
282
|
0
|
|
|
|
|
|
require File::Basename; |
283
|
0
|
|
|
|
|
|
$name = uc File::Basename::basename ($name); |
284
|
|
|
|
|
|
|
} else { |
285
|
|
|
|
|
|
|
# Lose everything up to the first of |
286
|
|
|
|
|
|
|
# */lib/*perl* standard or site_perl module |
287
|
|
|
|
|
|
|
# */*perl*/lib from -D prefix=/opt/perl |
288
|
|
|
|
|
|
|
# */*perl*/ random module hierarchy |
289
|
|
|
|
|
|
|
# which works. Should be fixed to use File::Spec. Also handle |
290
|
|
|
|
|
|
|
# a leading lib/ since that's what ExtUtils::MakeMaker creates. |
291
|
0
|
|
|
|
|
|
for ($name) { |
292
|
0
|
|
|
|
|
|
s%//+%/%g; |
293
|
0
|
0
|
0
|
|
|
|
if ( s%^.*?/lib/[^/]*perl[^/]*/%%si |
294
|
|
|
|
|
|
|
or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%si) { |
295
|
0
|
|
|
|
|
|
s%^site(_perl)?/%%s; # site and site_perl |
296
|
0
|
|
|
|
|
|
s%^(.*-$^O|$^O-.*)/%%so; # arch |
297
|
0
|
|
|
|
|
|
s%^\d+\.\d+%%s; # version |
298
|
|
|
|
|
|
|
} |
299
|
0
|
|
|
|
|
|
s%^lib/%%; |
300
|
0
|
|
|
|
|
|
s%/%::%g; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# If $name contains spaces, quote it; this mostly comes up in the case |
306
|
|
|
|
|
|
|
# of input from stdin. |
307
|
0
|
0
|
|
|
|
|
$name = '"' . $name . '"' if ($name =~ /\s/); |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# Modification date header. Try to use the modification time of our |
310
|
|
|
|
|
|
|
# input. |
311
|
|
|
|
|
|
|
# Note that DSR .DATE and $$ are for appearence in text, whereas |
312
|
|
|
|
|
|
|
# this date may appear in .! comments. |
313
|
0
|
0
|
|
|
|
|
if (!defined $$self{date}) { |
314
|
0
|
|
0
|
|
|
|
my $time = (stat $self->input_file)[9] || time; |
315
|
0
|
|
|
|
|
|
my ($day, $month, $year) = (localtime $time)[3,4,5]; |
316
|
|
|
|
|
|
|
# $month++; |
317
|
0
|
|
|
|
|
|
$month = ('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','NOV','DEC')[$month]; |
318
|
0
|
|
|
|
|
|
$year += 1900; |
319
|
|
|
|
|
|
|
# $$self{date} = sprintf ('%4d-%02d-%02d', $year, $month, $day); |
320
|
0
|
|
|
|
|
|
$$self{date} = sprintf ('%02d-%s-%4d', $day, $month, $year); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Now, print out the preamble and the title. |
324
|
0
|
|
|
|
|
|
local $_ = $PREAMBLE; |
325
|
0
|
|
|
|
|
|
s/\@LAYOUT\@/$$self{layout}/; |
326
|
|
|
|
|
|
|
# s/\@CFONT\@/$$self{fixed}/; |
327
|
|
|
|
|
|
|
# s/\@LQUOTE\@/$$self{LQUOTE}/; |
328
|
|
|
|
|
|
|
# s/\@RQUOTE\@/$$self{RQUOTE}/; |
329
|
0
|
|
|
|
|
|
chomp $_; |
330
|
0
|
|
|
|
|
|
print { $self->output_handle } <<"----END OF HEADER----"; |
|
0
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
.! Automatically generated by Pod::Dsr version $VERSION |
332
|
|
|
|
|
|
|
.! @{[ scalar localtime ]} |
333
|
|
|
|
|
|
|
.! |
334
|
|
|
|
|
|
|
.! Standard preamble: |
335
|
|
|
|
|
|
|
.! ====================================================================== |
336
|
|
|
|
|
|
|
$_ |
337
|
|
|
|
|
|
|
.! ====================================================================== |
338
|
|
|
|
|
|
|
.! |
339
|
|
|
|
|
|
|
.INDEX $name |
340
|
|
|
|
|
|
|
.TITLE $name |
341
|
|
|
|
|
|
|
.SUBTITLE "$$self{release}" "$$self{date}" "$$self{center}" |
342
|
|
|
|
|
|
|
----END OF HEADER---- |
343
|
|
|
|
|
|
|
#"# for cperl-mode |
344
|
0
|
|
|
|
|
|
my $chapter = $$self{chapter}; |
345
|
0
|
0
|
|
|
|
|
if ($chapter =~ /\d/) { |
346
|
0
|
|
|
|
|
|
print { $self->output_handle } <<"----END OF CHAPTER----"; |
|
0
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
.NUMBER CHAPTER $chapter |
348
|
|
|
|
|
|
|
.CHAPTER $name |
349
|
|
|
|
|
|
|
----END OF CHAPTER---- |
350
|
|
|
|
|
|
|
#"# for cperl-mode |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
# .INDEX is probably preferable to .ENTRY here. Did we want $name>$section? |
353
|
|
|
|
|
|
|
# Did we want .FIRST TITLE or instead ? |
354
|
|
|
|
|
|
|
# What to do with $section ? |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
# Initialize a few per-file variables. |
357
|
0
|
|
|
|
|
|
$$self{INDENT} = 0; |
358
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 0; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
############################################################################ |
363
|
|
|
|
|
|
|
# Core overrides |
364
|
|
|
|
|
|
|
############################################################################ |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# Called for each command paragraph. Gets the command, the associated |
367
|
|
|
|
|
|
|
# paragraph, the line number, and a Pod::Paragraph object. Just dispatches |
368
|
|
|
|
|
|
|
# the command to a method named the same as the command. =cut is handled |
369
|
|
|
|
|
|
|
# internally by Pod::Parser. |
370
|
|
|
|
|
|
|
sub command { |
371
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
372
|
0
|
|
|
|
|
|
my $command = shift; |
373
|
0
|
0
|
|
|
|
|
return if $command eq 'pod'; |
374
|
0
|
0
|
0
|
|
|
|
return if ($$self{EXCLUDE} && $command ne 'end'); |
375
|
0
|
0
|
|
|
|
|
if ($self->can ('cmd_' . $command)) { |
376
|
0
|
|
|
|
|
|
$command = 'cmd_' . $command; |
377
|
0
|
|
|
|
|
|
$self->$command (@_); |
378
|
|
|
|
|
|
|
} else { |
379
|
0
|
|
|
|
|
|
my ($text, $line, $paragraph) = @_; |
380
|
0
|
|
|
|
|
|
my $file; |
381
|
0
|
|
|
|
|
|
($file, $line) = $paragraph->file_line; |
382
|
0
|
|
|
|
|
|
$text =~ s/\n+\z//; |
383
|
0
|
0
|
|
|
|
|
$text = " $text" if ($text =~ /^\S/); |
384
|
0
|
|
|
|
|
|
warn qq($file:$line: Unknown command paragraph "=$command$text"\n); |
385
|
0
|
|
|
|
|
|
return; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# Called for a verbatim paragraph. Gets the paragraph, the line number, and |
390
|
|
|
|
|
|
|
# a Pod::Paragraph object. Rofficate backslashes, untabify, put a |
391
|
|
|
|
|
|
|
# zero-width character at the beginning of each line to protect against |
392
|
|
|
|
|
|
|
# commands, and wrap in .LITERAL/.END LITERAL. |
393
|
|
|
|
|
|
|
sub verbatim { |
394
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
395
|
0
|
0
|
|
|
|
|
return if $$self{EXCLUDE}; |
396
|
0
|
|
|
|
|
|
local $_ = shift; |
397
|
0
|
0
|
|
|
|
|
return if /^\s+$/; |
398
|
0
|
|
|
|
|
|
s/\s+$/\n/; |
399
|
|
|
|
|
|
|
# my $lines = tr/\n/\n/; |
400
|
|
|
|
|
|
|
## 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me; |
401
|
|
|
|
|
|
|
# s/\\/\\e/g; |
402
|
|
|
|
|
|
|
# s/^(\s*\S)/'\&' . $1/gme; |
403
|
0
|
|
|
|
|
|
$self->makespace; |
404
|
0
|
|
|
|
|
|
$self->output (".LITERAL\n$_.END LITERAL\n"); |
405
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 0; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
# Called for a regular text block. Gets the paragraph, the line number, and |
409
|
|
|
|
|
|
|
# a Pod::Paragraph object. Perform interpolation and output the results. |
410
|
|
|
|
|
|
|
sub textblock { |
411
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
412
|
0
|
0
|
|
|
|
|
return if $$self{EXCLUDE}; |
413
|
0
|
0
|
|
|
|
|
$self->output ($_[0]), return if $$self{VERBATIM}; |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
# Perform a little magic to collapse multiple L<> references. We'll |
416
|
|
|
|
|
|
|
# just rewrite the whole thing into actual text at this part, bypassing |
417
|
|
|
|
|
|
|
# the whole internal sequence parsing thing. |
418
|
0
|
|
|
|
|
|
my $text = shift; |
419
|
0
|
|
|
|
|
|
$text =~ s{ |
420
|
|
|
|
|
|
|
(L< # A link of the form L. |
421
|
|
|
|
|
|
|
/ |
422
|
|
|
|
|
|
|
( |
423
|
|
|
|
|
|
|
[:\w]+ # The item has to be a simple word... |
424
|
|
|
|
|
|
|
(\(\))? # ...or simple function. |
425
|
|
|
|
|
|
|
) |
426
|
|
|
|
|
|
|
> |
427
|
|
|
|
|
|
|
( |
428
|
|
|
|
|
|
|
,?\s+(and\s+)? # Allow lots of them, conjuncted. |
429
|
|
|
|
|
|
|
L< |
430
|
|
|
|
|
|
|
/ |
431
|
|
|
|
|
|
|
( [:\w]+ ( \(\) )? ) |
432
|
|
|
|
|
|
|
> |
433
|
|
|
|
|
|
|
)+ |
434
|
|
|
|
|
|
|
) |
435
|
|
|
|
|
|
|
} { |
436
|
0
|
|
|
|
|
|
local $_ = $1; |
437
|
0
|
|
|
|
|
|
s{ L< / ( [^>]+ ) > } {$1}xg; |
438
|
0
|
|
|
|
|
|
my @items = split /(?:,?\s+(?:and\s+)?)/; |
439
|
0
|
|
|
|
|
|
my $string = 'the '; |
440
|
0
|
|
|
|
|
|
my $i; |
441
|
0
|
|
|
|
|
|
for ($i = 0; $i < @items; $i++) { |
442
|
0
|
|
|
|
|
|
$string .= $items[$i]; |
443
|
0
|
0
|
0
|
|
|
|
$string .= ', ' if @items > 2 && $i != $#items; |
444
|
0
|
0
|
0
|
|
|
|
$string .= ' ' if @items == 2 && $i == 2; |
445
|
0
|
0
|
|
|
|
|
$string .= 'and ' if ($i == $#items - 1); |
446
|
|
|
|
|
|
|
} |
447
|
0
|
|
|
|
|
|
$string .= ' entries elsewhere in this document'; |
448
|
0
|
|
|
|
|
|
$string; |
449
|
|
|
|
|
|
|
}gex; |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
# Parse the tree and output it. collapse knows about references to |
452
|
|
|
|
|
|
|
# scalars as well as scalars and does the right thing with them. |
453
|
0
|
|
|
|
|
|
$text = $self->parse ($text, @_); |
454
|
0
|
|
|
|
|
|
$text =~ s/\n\s*$/\n/; |
455
|
0
|
|
|
|
|
|
$self->makespace; |
456
|
0
|
|
|
|
|
|
$self->output (protect $self->textmapfonts ($text)); |
457
|
0
|
|
|
|
|
|
$self->outindex; |
458
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 1; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# Called for an interior sequence. Takes a Pod::InteriorSequence object and |
462
|
|
|
|
|
|
|
# returns a reference to a scalar. This scalar is the final formatted text. |
463
|
|
|
|
|
|
|
# It's returned as a reference so that other interior sequences above us |
464
|
|
|
|
|
|
|
# know that the text has already been processed. |
465
|
|
|
|
|
|
|
sub sequence { |
466
|
0
|
|
|
0
|
1
|
|
my ($self, $seq) = @_; |
467
|
0
|
|
|
|
|
|
my $command = $seq->cmd_name; |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# Zero-width characters. |
470
|
0
|
0
|
|
|
|
|
if ($command eq 'Z') { |
471
|
|
|
|
|
|
|
# Workaround to generate a blessable reference, needed by 5.005. |
472
|
|
|
|
|
|
|
# my $tmp = '\&'; |
473
|
0
|
|
|
|
|
|
my $tmp = '#'; |
474
|
0
|
|
|
|
|
|
return bless \ "$tmp", 'Pod::Dsr::String'; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# C<>, L<>, X<>, and E<> don't apply guesswork to their contents. C<> |
478
|
|
|
|
|
|
|
# needs some additional special handling. |
479
|
0
|
|
|
|
|
|
my $literal = ($command =~ /^[CELX]$/); |
480
|
0
|
0
|
|
|
|
|
$literal++ if $command eq 'C'; |
481
|
0
|
|
|
|
|
|
local $_ = $self->collapse ($seq->parse_tree, $literal); |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# Handle E<> escapes. |
484
|
0
|
0
|
|
|
|
|
if ($command eq 'E') { |
485
|
0
|
0
|
|
|
|
|
if (/^\d+$/) { |
|
|
0
|
|
|
|
|
|
486
|
0
|
|
|
|
|
|
return bless \ chr ($_), 'Pod::Dsr::String'; |
487
|
|
|
|
|
|
|
} elsif (exists $ESCAPES{$_}) { |
488
|
0
|
|
|
|
|
|
return bless \ "$ESCAPES{$_}", 'Pod::Dsr::String'; |
489
|
|
|
|
|
|
|
} else { |
490
|
0
|
|
|
|
|
|
carp "Unknown escape E<$1>"; |
491
|
0
|
|
|
|
|
|
return bless \ "E<$_>", 'Pod::Dsr::String'; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# For all the other sequences, empty content produces no output. |
496
|
0
|
0
|
|
|
|
|
return '' if $_ eq ''; |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
# Handle formatting sequences. |
499
|
0
|
0
|
|
|
|
|
if ($command eq 'B') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
500
|
|
|
|
|
|
|
# return bless \ ('\f(BS' . $_ . '\f(BE'), 'Pod::Dsr::String'; |
501
|
0
|
|
|
|
|
|
return bless \ ('^*' . $_ . '\*'), 'Pod::Dsr::String'; |
502
|
|
|
|
|
|
|
} elsif ($command eq 'F') { |
503
|
|
|
|
|
|
|
# return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Dsr::String'; |
504
|
0
|
|
|
|
|
|
return bless \ ( $_ ), 'Pod::Dsr::String'; |
505
|
|
|
|
|
|
|
} elsif ($command eq 'I') { |
506
|
|
|
|
|
|
|
# return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Dsr::String'; |
507
|
0
|
|
|
|
|
|
return bless \ ('^&' . $_ . '\&'), 'Pod::Dsr::String'; |
508
|
|
|
|
|
|
|
} elsif ($command eq 'C') { |
509
|
|
|
|
|
|
|
# return bless \ ('\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"), |
510
|
0
|
|
|
|
|
|
return bless \ ($_), |
511
|
|
|
|
|
|
|
'Pod::Dsr::String'; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# Handle links. |
515
|
0
|
0
|
|
|
|
|
if ($command eq 'L') { |
516
|
|
|
|
|
|
|
# A bug in lvalue subs in 5.6 requires the temporary variable. |
517
|
0
|
|
|
|
|
|
my $tmp = $self->buildlink ($_); |
518
|
0
|
|
|
|
|
|
return bless \ "$tmp", 'Pod::Dsr::String'; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
# Whitespace protection replaces whitespace with "\ ". |
522
|
0
|
0
|
|
|
|
|
if ($command eq 'S') { |
523
|
|
|
|
|
|
|
# s/\s+/\\ /g; |
524
|
0
|
|
|
|
|
|
return bless \ "$_", 'Pod::Dsr::String'; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
# Add an index entry to the list of ones waiting to be output. |
528
|
0
|
0
|
|
|
|
|
if ($command eq 'X') { push (@{ $$self{INDEX} }, $_); return '' } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
# Anything else is unknown. |
531
|
0
|
|
|
|
|
|
carp "Unknown sequence $command<$_>"; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
############################################################################ |
536
|
|
|
|
|
|
|
# Command paragraphs |
537
|
|
|
|
|
|
|
############################################################################ |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# All command paragraphs take the paragraph and the line number. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# .SH |
542
|
|
|
|
|
|
|
# already uses small caps, so remove any E<> sequences that would cause |
543
|
|
|
|
|
|
|
# them. |
544
|
|
|
|
|
|
|
sub cmd_head1 { |
545
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
546
|
0
|
|
|
|
|
|
local $_ = $self->parse (@_); |
547
|
0
|
|
|
|
|
|
s/\s+$//; |
548
|
0
|
|
|
|
|
|
s/\\s-?\d//g; |
549
|
0
|
|
|
|
|
|
s/\s*\n\s*/ /g; |
550
|
0
|
0
|
|
|
|
|
if ($$self{ITEMS} > 1) { |
551
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; |
552
|
|
|
|
|
|
|
} |
553
|
0
|
|
|
|
|
|
$self->output ($self->switchquotes ('.HEADER LEVEL 1', $self->mapfonts ($_))); |
554
|
0
|
0
|
|
|
|
|
$self->outindex (($_ eq 'NAME') ? () : ($_)); |
555
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 0; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
# Second level heading. |
559
|
|
|
|
|
|
|
sub cmd_head2 { |
560
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
561
|
0
|
|
|
|
|
|
local $_ = $self->parse (@_); |
562
|
0
|
|
|
|
|
|
s/\s+$//; |
563
|
0
|
|
|
|
|
|
s/\s*\n\s*/ /g; |
564
|
0
|
0
|
|
|
|
|
if ($$self{ITEMS} > 1) { |
565
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; |
566
|
|
|
|
|
|
|
} |
567
|
0
|
|
|
|
|
|
$self->output ($self->switchquotes ('.HEADER LEVEL 2', $self->mapfonts ($_))); |
568
|
0
|
|
|
|
|
|
$self->outindex ($_); |
569
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 0; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# Third level heading. |
573
|
|
|
|
|
|
|
sub cmd_head3 { |
574
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
575
|
0
|
|
|
|
|
|
local $_ = $self->parse (@_); |
576
|
0
|
|
|
|
|
|
s/\s+$//; |
577
|
0
|
|
|
|
|
|
s/\s*\n\s*/ /g; |
578
|
0
|
0
|
|
|
|
|
if ($$self{ITEMS} > 1) { |
579
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; |
580
|
|
|
|
|
|
|
} |
581
|
0
|
|
|
|
|
|
$self->makespace; |
582
|
0
|
|
|
|
|
|
$self->output ($self->switchquotes ('.HEADER LEVEL 3', $self->mapfonts ($_))); |
583
|
0
|
|
|
|
|
|
$self->outindex ($_); |
584
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 1; |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
# Fourth level heading. DSR only offsets from test to .HEADER LEVEL 3 |
588
|
|
|
|
|
|
|
sub cmd_head4 { |
589
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
590
|
0
|
|
|
|
|
|
local $_ = $self->parse (@_); |
591
|
0
|
|
|
|
|
|
s/\s+$//; |
592
|
0
|
|
|
|
|
|
s/\s*\n\s*/ /g; |
593
|
0
|
0
|
|
|
|
|
if ($$self{ITEMS} > 1) { |
594
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; |
595
|
|
|
|
|
|
|
} |
596
|
0
|
|
|
|
|
|
$self->makespace; |
597
|
0
|
|
|
|
|
|
$self->output ($self->switchquotes ('.HEADER LEVEL 3', $self->mapfonts ($_))); |
598
|
0
|
|
|
|
|
|
$self->outindex ($_); |
599
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 1; |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
# Fifth level heading -> .HEADER LEVEL 4 |
603
|
|
|
|
|
|
|
sub cmd_head5 { |
604
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
605
|
0
|
|
|
|
|
|
local $_ = $self->parse (@_); |
606
|
0
|
|
|
|
|
|
s/\s+$//; |
607
|
0
|
|
|
|
|
|
s/\s*\n\s*/ /g; |
608
|
0
|
0
|
|
|
|
|
if ($$self{ITEMS} > 1) { |
609
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; |
610
|
|
|
|
|
|
|
} |
611
|
0
|
|
|
|
|
|
$self->makespace; |
612
|
0
|
|
|
|
|
|
$self->output ($self->switchquotes ('.HEADER LEVEL 4', $self->mapfonts ($_))); |
613
|
0
|
|
|
|
|
|
$self->outindex ($_); |
614
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 1; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
# Sixth level heading. .HEADER LEVEL 5 |
618
|
|
|
|
|
|
|
sub cmd_head6 { |
619
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
620
|
0
|
|
|
|
|
|
local $_ = $self->parse (@_); |
621
|
0
|
|
|
|
|
|
s/\s+$//; |
622
|
0
|
|
|
|
|
|
s/\s*\n\s*/ /g; |
623
|
0
|
0
|
|
|
|
|
if ($$self{ITEMS} > 1) { |
624
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; |
625
|
|
|
|
|
|
|
} |
626
|
0
|
|
|
|
|
|
$self->makespace; |
627
|
0
|
|
|
|
|
|
$self->output ($self->switchquotes ('.HEADER LEVEL 5', $self->mapfonts ($_))); |
628
|
0
|
|
|
|
|
|
$self->outindex ($_); |
629
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 1; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# Start a list. |
633
|
|
|
|
|
|
|
sub cmd_over { |
634
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
635
|
0
|
|
|
|
|
|
local $_ = shift; |
636
|
0
|
0
|
|
|
|
|
unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} } |
|
0
|
|
|
|
|
|
|
637
|
0
|
0
|
|
|
|
|
if (@{ $$self{INDENTS} } > -1) { |
|
0
|
|
|
|
|
|
|
638
|
0
|
|
|
|
|
|
$self->output (".LIST\n"); |
639
|
|
|
|
|
|
|
} |
640
|
0
|
|
|
|
|
|
push (@{ $$self{INDENTS} }, $$self{INDENT}); |
|
0
|
|
|
|
|
|
|
641
|
0
|
|
|
|
|
|
$$self{INDENT} = ($_ + 0); |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# End a list. If we've closed an embedded indent, we've mangled the hanging |
645
|
|
|
|
|
|
|
# paragraph indent, so temporarily replace it with .RS and set WEIRDINDENT. |
646
|
|
|
|
|
|
|
# We'll close that .RS at the next =back or =item. |
647
|
|
|
|
|
|
|
sub cmd_back { |
648
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
649
|
0
|
|
|
|
|
|
$$self{INDENT} = pop @{ $$self{INDENTS} }; |
|
0
|
|
|
|
|
|
|
650
|
0
|
0
|
|
|
|
|
unless (defined $$self{INDENT}) { |
651
|
0
|
|
|
|
|
|
carp "Unmatched =back"; |
652
|
0
|
|
|
|
|
|
$$self{INDENT} = 0; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
# if ($$self{WEIRDINDENT}) { |
655
|
|
|
|
|
|
|
# $self->output (".END LIST\n"); |
656
|
|
|
|
|
|
|
# $$self{WEIRDINDENT} = 0; |
657
|
|
|
|
|
|
|
# } |
658
|
0
|
0
|
|
|
|
|
if (@{ $$self{INDENTS} } > -1) { |
|
0
|
|
|
|
|
|
|
659
|
0
|
|
|
|
|
|
$self->output (".END LIST\n"); |
660
|
0
|
|
|
|
|
|
$$self{WEIRDINDENT} = 1; |
661
|
|
|
|
|
|
|
} |
662
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 1; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# An individual list item. Emit an index entry for anything that's |
666
|
|
|
|
|
|
|
# interesting, but don't emit index entries for things like bullets and |
667
|
|
|
|
|
|
|
# numbers. Turn * bullets into center dot characters (DEC MNCS) so use |
668
|
|
|
|
|
|
|
# * for your lists rather than o or . or - or some other thing. Newlines |
669
|
|
|
|
|
|
|
# in an item title are turned into spaces since RUNOFF can't handle them |
670
|
|
|
|
|
|
|
# embedded. |
671
|
|
|
|
|
|
|
sub cmd_item { |
672
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
673
|
0
|
|
|
|
|
|
local $_ = $self->parse (@_); |
674
|
0
|
|
|
|
|
|
s/\s+$//; |
675
|
0
|
|
|
|
|
|
s/\s*\n\s*/ /g; |
676
|
0
|
|
|
|
|
|
my $index; |
677
|
0
|
0
|
0
|
|
|
|
if (/\w/ && !/^\w[.\)]\s*$/) { |
678
|
0
|
|
|
|
|
|
$index = $_; |
679
|
0
|
|
|
|
|
|
$index =~ s/^\s*[-*+o.]?(?:\s+|\Z)//; |
680
|
|
|
|
|
|
|
} |
681
|
0
|
|
|
|
|
|
s/^\*(\s|\Z)/·$1/; |
682
|
|
|
|
|
|
|
# if ($$self{WEIRDINDENT}) { |
683
|
|
|
|
|
|
|
# $self->output (".LIST ELEMENT;"); |
684
|
|
|
|
|
|
|
# $$self{WEIRDINDENT} = 0; |
685
|
|
|
|
|
|
|
# } |
686
|
0
|
|
|
|
|
|
$_ = $self->textmapfonts ($_); |
687
|
0
|
|
|
|
|
|
$self->output ($self->switchquotes ('.LIST ELEMENT;', $_ )); |
688
|
0
|
0
|
|
|
|
|
$self->outindex ($index ? ('Item', $index) : ()); |
689
|
0
|
|
|
|
|
|
$$self{NEEDSPACE} = 0; |
690
|
0
|
|
|
|
|
|
$$self{ITEMS}++; |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
# Begin a block for a particular translator. Setting VERBATIM triggers |
694
|
|
|
|
|
|
|
# special handling in textblock(). |
695
|
|
|
|
|
|
|
sub cmd_begin { |
696
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
697
|
0
|
|
|
|
|
|
local $_ = shift; |
698
|
0
|
0
|
|
|
|
|
my ($kind) = /^(\S+)/ or return; |
699
|
0
|
0
|
0
|
|
|
|
if ($kind eq 'man' || $kind eq 'roff' || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
700
|
|
|
|
|
|
|
$kind eq 'dsr' || $kind eq 'rno') { |
701
|
0
|
|
|
|
|
|
$$self{VERBATIM} = 1; |
702
|
|
|
|
|
|
|
} else { |
703
|
0
|
|
|
|
|
|
$$self{EXCLUDE} = 1; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
# End a block for a particular translator. We assume that all =begin/=end |
708
|
|
|
|
|
|
|
# pairs are properly closed. |
709
|
|
|
|
|
|
|
sub cmd_end { |
710
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
711
|
0
|
|
|
|
|
|
$$self{EXCLUDE} = 0; |
712
|
0
|
|
|
|
|
|
$$self{VERBATIM} = 0; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# One paragraph for a particular translator. Ignore it unless it's intended |
716
|
|
|
|
|
|
|
# for dsr, rno, man or roff; in which case we output it verbatim. |
717
|
|
|
|
|
|
|
sub cmd_for { |
718
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
719
|
0
|
|
|
|
|
|
local $_ = shift; |
720
|
0
|
0
|
|
|
|
|
return unless s/^(?:dsr|rno|man|roff)\b[ \t]*\n?//; |
721
|
0
|
|
|
|
|
|
$self->output ($_); |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
############################################################################ |
726
|
|
|
|
|
|
|
# Link handling |
727
|
|
|
|
|
|
|
############################################################################ |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
# Handle links. We can't actually make real hyperlinks, so this is all to |
730
|
|
|
|
|
|
|
# figure out what text and formatting we print out. |
731
|
|
|
|
|
|
|
sub buildlink { |
732
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
733
|
0
|
|
|
|
|
|
local $_ = shift; |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
# Smash whitespace in case we were split across multiple lines. |
736
|
0
|
|
|
|
|
|
s/\s+/ /g; |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
# If we were given any explicit text, just output it. |
739
|
0
|
0
|
|
|
|
|
if (m{ ^ ([^|]+) \| }x) { return $1 } |
|
0
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
# Okay, leading and trailing whitespace isn't important. |
742
|
0
|
|
|
|
|
|
s/^\s+//; |
743
|
0
|
|
|
|
|
|
s/\s+$//; |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# Default to using the whole content of the link entry as a section |
746
|
|
|
|
|
|
|
# name. Note that L forces a manpage interpretation, as does |
747
|
|
|
|
|
|
|
# something looking like L. Do the same thing to |
748
|
|
|
|
|
|
|
# L as we would to manpage(section) without the L<>; |
749
|
|
|
|
|
|
|
# see guesswork(). If we've added italics, don't add the "manpage" |
750
|
|
|
|
|
|
|
# text; markup is sufficient. |
751
|
|
|
|
|
|
|
# DSR note: s/manpage/document/g; in the above. |
752
|
0
|
|
|
|
|
|
my ($manpage, $section) = ('', $_); |
753
|
0
|
0
|
|
|
|
|
if (/^"\s*(.*?)\s*"$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
754
|
0
|
|
|
|
|
|
$section = $1; |
755
|
|
|
|
|
|
|
} elsif (m{ ^ [-:.\w]+ (?: \( \S+ \) )? $ }x) { |
756
|
0
|
|
|
|
|
|
($manpage, $section) = ($_, ''); |
757
|
0
|
|
|
|
|
|
$manpage =~ s/^([^\(]+)\(/'^&' . $1 . '\&('/e; |
|
0
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
} elsif (m%/%) { |
759
|
0
|
|
|
|
|
|
($manpage, $section) = split (/\s*\/\s*/, $_, 2); |
760
|
0
|
0
|
|
|
|
|
if ($manpage =~ /^[-:.\w]+(?:\(\S+\))?$/) { |
761
|
|
|
|
|
|
|
# $manpage =~ s/^([^\(]+)\(/'\f(IS' . $1 . '\f(IE\|'/e; |
762
|
|
|
|
|
|
|
} |
763
|
0
|
|
|
|
|
|
$section =~ s/^\"\s*//; |
764
|
0
|
|
|
|
|
|
$section =~ s/\s*\"$//; |
765
|
|
|
|
|
|
|
} |
766
|
0
|
0
|
0
|
|
|
|
if ($manpage && $manpage !~ /\^\&/) { |
767
|
0
|
|
|
|
|
|
$manpage = "the $manpage document"; |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# Now build the actual output text. |
771
|
0
|
|
|
|
|
|
my $text = ''; |
772
|
0
|
0
|
0
|
|
|
|
if (!length ($section) && !length ($manpage)) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
773
|
0
|
|
|
|
|
|
carp "Invalid link $_"; |
774
|
|
|
|
|
|
|
} elsif (!length ($section)) { |
775
|
0
|
|
|
|
|
|
$text = $manpage; |
776
|
|
|
|
|
|
|
} elsif ($section =~ /^[:\w]+(?:\(\))?/) { |
777
|
0
|
|
|
|
|
|
$text .= 'the ' . $section . ' entry'; |
778
|
0
|
0
|
|
|
|
|
$text .= (length $manpage) ? " in $manpage" |
779
|
|
|
|
|
|
|
: " elsewhere in this document"; |
780
|
|
|
|
|
|
|
} else { |
781
|
0
|
0
|
|
|
|
|
if ($section !~ /^".*"$/) { $section = '"' . $section . '"' } |
|
0
|
|
|
|
|
|
|
782
|
0
|
|
|
|
|
|
$text .= 'the section on ' . $section; |
783
|
0
|
0
|
|
|
|
|
$text .= " in $manpage" if length $manpage; |
784
|
|
|
|
|
|
|
} |
785
|
0
|
|
|
|
|
|
$text; |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
############################################################################ |
790
|
|
|
|
|
|
|
# Escaping and fontification |
791
|
|
|
|
|
|
|
############################################################################ |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
# At this point, we'll have embedded font codes of the form \f([SE] |
794
|
|
|
|
|
|
|
# where is one of B, I, or F. Turn those into the right font start |
795
|
|
|
|
|
|
|
# or end codes. The old pod2man didn't get B else> right; |
796
|
|
|
|
|
|
|
# after I<> it switched back to normal text rather than bold. We take care |
797
|
|
|
|
|
|
|
# of this by using variables as a combined pointer to our current font |
798
|
|
|
|
|
|
|
# sequence, and set each to the number of current nestings of start tags for |
799
|
|
|
|
|
|
|
# that font. Use them as a vector to look up what font sequence to use. |
800
|
|
|
|
|
|
|
# |
801
|
|
|
|
|
|
|
# \fP changes to the previous font, but only one previous font is kept. We |
802
|
|
|
|
|
|
|
# don't know what the outside level font is; normally it's R, but if we're |
803
|
|
|
|
|
|
|
# inside a heading it could be something else. So arrange things so that |
804
|
|
|
|
|
|
|
# the outside font is always the "previous" font and end with \fP instead of |
805
|
|
|
|
|
|
|
# \fR. Idea from Zack Weinberg. |
806
|
|
|
|
|
|
|
sub mapfonts { |
807
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
808
|
0
|
|
|
|
|
|
local $_ = shift; |
809
|
|
|
|
|
|
|
|
810
|
0
|
|
|
|
|
|
my ($fixed, $bold, $italic) = (0, 0, 0); |
811
|
0
|
|
|
|
|
|
my %magic = (F => \$fixed, B => \$bold, I => \$italic); |
812
|
0
|
|
|
|
|
|
my $last = '\fR'; |
813
|
0
|
|
|
|
|
|
s { \\f\((.)(.) } { |
814
|
0
|
|
|
|
|
|
my $sequence = ''; |
815
|
0
|
|
|
|
|
|
my $f; |
816
|
0
|
0
|
|
|
|
|
if ($last ne '\fR') { $sequence = '\fP' } |
|
0
|
|
|
|
|
|
|
817
|
0
|
0
|
|
|
|
|
${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; |
|
0
|
|
|
|
|
|
|
818
|
0
|
|
0
|
|
|
|
$f = $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)}; |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
819
|
0
|
0
|
|
|
|
|
if ($f eq $last) { |
820
|
0
|
|
|
|
|
|
''; |
821
|
|
|
|
|
|
|
} else { |
822
|
0
|
0
|
|
|
|
|
if ($f ne '\fR') { $sequence .= $f } |
|
0
|
|
|
|
|
|
|
823
|
0
|
|
|
|
|
|
$last = $f; |
824
|
0
|
|
|
|
|
|
$sequence; |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
}gxe; |
827
|
0
|
|
|
|
|
|
$_; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU |
831
|
|
|
|
|
|
|
# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather |
832
|
|
|
|
|
|
|
# than R, presumably because \f(CW doesn't actually do a font change. To |
833
|
|
|
|
|
|
|
# work around this, use a separate textmapfonts for text blocks where the |
834
|
|
|
|
|
|
|
# default font is always R and only use the smart mapfonts for headings. |
835
|
|
|
|
|
|
|
sub textmapfonts { |
836
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
837
|
0
|
|
|
|
|
|
local $_ = shift; |
838
|
|
|
|
|
|
|
|
839
|
0
|
|
|
|
|
|
my ($fixed, $bold, $italic) = (0, 0, 0); |
840
|
0
|
|
|
|
|
|
my %magic = (F => \$fixed, B => \$bold, I => \$italic); |
841
|
0
|
|
|
|
|
|
s { \\f\((.)(.) } { |
842
|
0
|
0
|
|
|
|
|
${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; |
|
0
|
|
|
|
|
|
|
843
|
0
|
|
0
|
|
|
|
$$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)}; |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
844
|
|
|
|
|
|
|
}gxe; |
845
|
0
|
|
|
|
|
|
$_; |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
############################################################################ |
850
|
|
|
|
|
|
|
# *roff-specific parsing |
851
|
|
|
|
|
|
|
############################################################################ |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
# Called instead of parse_text, calls parse_text with the right flags. |
854
|
|
|
|
|
|
|
sub parse { |
855
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
856
|
0
|
|
|
|
|
|
$self->parse_text ({ -expand_seq => 'sequence', |
857
|
|
|
|
|
|
|
-expand_ptree => 'collapse' }, @_); |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
# Takes a parse tree and a flag saying whether or not to treat it as literal |
861
|
|
|
|
|
|
|
# text (not call guesswork on it), and returns the concatenation of all of |
862
|
|
|
|
|
|
|
# the text strings in that parse tree. If the literal flag isn't true, |
863
|
|
|
|
|
|
|
# guesswork() will be called on all plain scalars in the parse tree. |
864
|
|
|
|
|
|
|
# Otherwise, just escape backslashes in the normal case. If collapse is |
865
|
|
|
|
|
|
|
# being called on a C<> sequence, literal is set to 2, and we do some |
866
|
|
|
|
|
|
|
# additional cleanup. Assumes that everything in the parse tree is either a |
867
|
|
|
|
|
|
|
# scalar or a reference to a scalar. |
868
|
|
|
|
|
|
|
sub collapse { |
869
|
0
|
|
|
0
|
0
|
|
my ($self, $ptree, $literal) = @_; |
870
|
0
|
0
|
|
|
|
|
if ($literal) { |
871
|
|
|
|
|
|
|
return join ('', map { |
872
|
0
|
0
|
|
|
|
|
if (ref $_) { |
|
0
|
|
|
|
|
|
|
873
|
0
|
|
|
|
|
|
$$_; |
874
|
|
|
|
|
|
|
} else { |
875
|
0
|
|
|
|
|
|
s/\\/\\e/g; |
876
|
0
|
0
|
|
|
|
|
s/-/\\-/g if $literal > 1; |
877
|
0
|
0
|
|
|
|
|
s/__/_\\|_/g if $literal > 1; |
878
|
0
|
|
|
|
|
|
$_; |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
} $ptree->children); |
881
|
|
|
|
|
|
|
} else { |
882
|
0
|
0
|
|
|
|
|
return join ('', map { |
883
|
0
|
|
|
|
|
|
ref ($_) ? $$_ : $self->guesswork ($_) |
884
|
|
|
|
|
|
|
} $ptree->children); |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
} |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
# Takes a text block to perform guesswork on; this is guaranteed not to |
889
|
|
|
|
|
|
|
# contain any interior sequences. Returns the text block with remapping |
890
|
|
|
|
|
|
|
# done. |
891
|
|
|
|
|
|
|
sub guesswork { |
892
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
893
|
0
|
|
|
|
|
|
local $_ = shift; |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
# rofficate backslashes. |
896
|
|
|
|
|
|
|
# s/\\/\\e/g; |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
# Ensure double underbars have a tiny space between them. |
899
|
|
|
|
|
|
|
# s/__/_\\|_/g; |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
# Make all caps a little smaller. Be careful here, since we don't want |
902
|
|
|
|
|
|
|
# to make @ARGV into small caps, nor do we want to fix the MIME in |
903
|
|
|
|
|
|
|
# MIME-Version, since it looks weird with the full-height V. |
904
|
|
|
|
|
|
|
# s{ |
905
|
|
|
|
|
|
|
# ( ^ | [\s\(\"\'\`\[\{<>] ) |
906
|
|
|
|
|
|
|
# ( [A-Z] [A-Z] [/A-Z+:\d_\$&-]* ) |
907
|
|
|
|
|
|
|
# (?: (?= [\s>\}\]\)\'\".?!,;:] | -- ) | $ ) |
908
|
|
|
|
|
|
|
# } { $1 . '\s-1' . $2 . '\s0' }egx; |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
# Turn PI into a pretty pi. |
911
|
|
|
|
|
|
|
# s{ (?: \\s-1 | \b ) PI (?: \\s0 | \b ) } {\\*\(PI}gx; |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
# Underline functions in the form func(). |
914
|
0
|
|
|
|
|
|
s{ |
915
|
|
|
|
|
|
|
\b |
916
|
|
|
|
|
|
|
( |
917
|
|
|
|
|
|
|
[:\w]+ (?:\\s-1)? \(\) |
918
|
|
|
|
|
|
|
) |
919
|
0
|
|
|
|
|
|
} { '^&' . $1 . '\&' }egx; |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
# func(n) is a reference to a manual page. Make it ^&func\&(n). |
922
|
0
|
|
|
|
|
|
s{ |
923
|
|
|
|
|
|
|
\b |
924
|
|
|
|
|
|
|
(\w[-:.\w]+ (?:\\s-1)?) |
925
|
|
|
|
|
|
|
( |
926
|
|
|
|
|
|
|
\( [^\)] \) |
927
|
|
|
|
|
|
|
) |
928
|
0
|
|
|
|
|
|
} { '^&' . $1 . '\&' . $2 }egx; |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
# Convert simple Perl variable references to a fixed-width font. |
931
|
|
|
|
|
|
|
# s{ |
932
|
|
|
|
|
|
|
# ( \s+ ) |
933
|
|
|
|
|
|
|
# ( [\$\@%] [\w:]+ ) |
934
|
|
|
|
|
|
|
# (?! \( ) |
935
|
|
|
|
|
|
|
# } { $1 . '\f(FS' . $2 . '\f(FE'}egx; |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
# Translate -- into a real em dash if it's used like one and fix up |
938
|
|
|
|
|
|
|
# dashes, but keep hyphens hyphens. |
939
|
|
|
|
|
|
|
# s{ (\G|^|.) (-+) (\b|.) } { |
940
|
|
|
|
|
|
|
# my ($pre, $dash, $post) = ($1, $2, $3); |
941
|
|
|
|
|
|
|
# if (length ($dash) == 1) { |
942
|
|
|
|
|
|
|
# ($pre =~ /[a-zA-Z]/) ? "$pre-$post" : "$pre\\-$post"; |
943
|
|
|
|
|
|
|
# } elsif (length ($dash) == 2 |
944
|
|
|
|
|
|
|
# && ((!$pre && !$post) |
945
|
|
|
|
|
|
|
# || ($pre =~ /\w/ && !$post) |
946
|
|
|
|
|
|
|
# || ($pre eq ' ' && $post eq ' ') |
947
|
|
|
|
|
|
|
# || ($pre eq '=' && $post ne '=') |
948
|
|
|
|
|
|
|
# || ($pre ne '=' && $post eq '='))) { |
949
|
|
|
|
|
|
|
# "$pre\\*(--$post"; |
950
|
|
|
|
|
|
|
# } else { |
951
|
|
|
|
|
|
|
# $pre . ('\-' x length $dash) . $post; |
952
|
|
|
|
|
|
|
# } |
953
|
|
|
|
|
|
|
# }egxs; |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
# All done. |
956
|
0
|
|
|
|
|
|
$_; |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
############################################################################ |
961
|
|
|
|
|
|
|
# Output formatting |
962
|
|
|
|
|
|
|
############################################################################ |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
# Make vertical whitespace. |
965
|
|
|
|
|
|
|
sub makespace { |
966
|
0
|
|
|
0
|
|
|
my $self = shift; |
967
|
0
|
0
|
|
|
|
|
$self->output (".BREAK\n") if ($$self{ITEMS} > 1); |
968
|
0
|
|
|
|
|
|
$$self{ITEMS} = 0; |
969
|
0
|
0
|
|
|
|
|
$self->output ($$self{INDENT} > 0 ? ".PARAGRAPH\n" : ".PARAGRAPH\n") |
|
|
0
|
|
|
|
|
|
970
|
|
|
|
|
|
|
if $$self{NEEDSPACE}; |
971
|
|
|
|
|
|
|
} |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
# Output any pending index entries, and optionally an index entry given as |
974
|
|
|
|
|
|
|
# an argument. Support multiple index entries in X<> separated by slashes, |
975
|
|
|
|
|
|
|
# and strip special escapes from index entries. |
976
|
|
|
|
|
|
|
sub outindex { |
977
|
0
|
|
|
0
|
0
|
|
my ($self, $section, $index) = @_; |
978
|
0
|
|
|
|
|
|
my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
979
|
0
|
0
|
0
|
|
|
|
return unless ($section || @entries); |
980
|
0
|
|
|
|
|
|
$$self{INDEX} = []; |
981
|
0
|
|
|
|
|
|
my $output; |
982
|
0
|
0
|
|
|
|
|
if (@entries) { |
983
|
0
|
|
|
|
|
|
my $output = '.INDEX ' |
984
|
|
|
|
|
|
|
. join (' ', @entries) |
985
|
|
|
|
|
|
|
. "\n"; |
986
|
|
|
|
|
|
|
} |
987
|
0
|
0
|
|
|
|
|
if ($section) { |
988
|
0
|
0
|
0
|
|
|
|
if (defined($index) && $index ne '') { |
989
|
0
|
|
|
|
|
|
$index =~ s/\\-/-/g; |
990
|
0
|
|
|
|
|
|
$index =~ s/\\(?:s-?\d|.\(..|.)//g; |
991
|
0
|
|
|
|
|
|
$output .= ".INDEX $section>$index\n"; |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
else { |
994
|
0
|
|
|
|
|
|
$output .= ".INDEX $section\n"; |
995
|
|
|
|
|
|
|
} |
996
|
|
|
|
|
|
|
} |
997
|
0
|
|
|
|
|
|
$self->output ($output); |
998
|
|
|
|
|
|
|
} |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
# Output text to the output device. |
1001
|
0
|
|
|
0
|
0
|
|
sub output { print { $_[0]->output_handle } $_[1] } |
|
0
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
# Given a command and a single argument that may or may not contain double |
1004
|
|
|
|
|
|
|
# quotes, handle double-quote formatting for it. If there are no double |
1005
|
|
|
|
|
|
|
# quotes, just return the command followed by the argument in double quotes. |
1006
|
|
|
|
|
|
|
# If there are double quotes, use an if statement to test for nroff, and for |
1007
|
|
|
|
|
|
|
# nroff output the command followed by the argument in double quotes with |
1008
|
|
|
|
|
|
|
# embedded double quotes doubled. For other formatters, remap paired double |
1009
|
|
|
|
|
|
|
# quotes to LQUOTE and RQUOTE. |
1010
|
|
|
|
|
|
|
sub switchquotes { |
1011
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1012
|
0
|
|
|
|
|
|
my $command = shift; |
1013
|
0
|
|
|
|
|
|
local $_ = shift; |
1014
|
0
|
|
|
|
|
|
my $extra = shift; |
1015
|
0
|
|
|
|
|
|
s/\\\*\([LR]\"/\"/g; |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
# We also have to deal with \*C` and \*C', which are used to add the |
1018
|
|
|
|
|
|
|
# quotes around C<> text, since they may expand to " and if they do this |
1019
|
|
|
|
|
|
|
# confuses the .SH macros and the like no end. Expand them ourselves. |
1020
|
|
|
|
|
|
|
# If $extra is set, we're dealing with =item, which in most nroff macro |
1021
|
|
|
|
|
|
|
# sets requires an extra level of quoting of double quotes. |
1022
|
0
|
|
0
|
|
|
|
my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/); |
1023
|
0
|
0
|
0
|
|
|
|
if (/\"/ || ($c_is_quote && /\\\*\(C[\'\`]/)) { |
|
|
|
0
|
|
|
|
|
1024
|
0
|
|
|
|
|
|
s/\"/\"\"/g; |
1025
|
0
|
|
|
|
|
|
my $troff = $_; |
1026
|
0
|
|
|
|
|
|
$troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; |
1027
|
0
|
|
|
|
|
|
s/\\\*\(C\`/$$self{LQUOTE}/g; |
1028
|
0
|
|
|
|
|
|
s/\\\*\(C\'/$$self{RQUOTE}/g; |
1029
|
0
|
|
|
|
|
|
$troff =~ s/\\\*\(C[\'\`]//g; |
1030
|
0
|
0
|
|
|
|
|
s/\"/\"\"/g if $extra; |
1031
|
0
|
0
|
|
|
|
|
$troff =~ s/\"/\"\"/g if $extra; |
1032
|
0
|
0
|
|
|
|
|
$_ = qq("$_") . ($extra ? " $extra" : ''); |
1033
|
0
|
0
|
|
|
|
|
$troff = qq("$troff") . ($extra ? " $extra" : ''); |
1034
|
0
|
|
|
|
|
|
return ".if n $command $_\n.el $command $troff\n"; |
1035
|
|
|
|
|
|
|
} else { |
1036
|
0
|
0
|
|
|
|
|
$_ = qq("$_") . ($extra ? " $extra" : ''); |
1037
|
0
|
|
|
|
|
|
return "$command $_\n"; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
__END__ |