1 | # Copyright (C) 2003 Free Software Foundation, Inc.
|
---|
2 |
|
---|
3 | # This program is free software; you can redistribute it and/or modify
|
---|
4 | # it under the terms of the GNU General Public License as published by
|
---|
5 | # the Free Software Foundation; either version 2, or (at your option)
|
---|
6 | # any later version.
|
---|
7 |
|
---|
8 | # This program is distributed in the hope that it will be useful,
|
---|
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
11 | # GNU General Public License for more details.
|
---|
12 |
|
---|
13 | # You should have received a copy of the GNU General Public License
|
---|
14 | # along with this program; if not, write to the Free Software
|
---|
15 | # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
---|
16 | # 02111-1307, USA.
|
---|
17 |
|
---|
18 | package Automake::Wrap;
|
---|
19 |
|
---|
20 | use strict;
|
---|
21 |
|
---|
22 | require Exporter;
|
---|
23 | use vars '@ISA', '@EXPORT_OK';
|
---|
24 | @ISA = qw/Exporter/;
|
---|
25 | @EXPORT_OK = qw/wrap makefile_wrap/;
|
---|
26 |
|
---|
27 | =head1 NAME
|
---|
28 |
|
---|
29 | Automake::Wrap - a paragraph formater
|
---|
30 |
|
---|
31 | =head1 SYNOPSIS
|
---|
32 |
|
---|
33 | use Automake::Wrap 'wrap', 'makefile_wrap';
|
---|
34 |
|
---|
35 | print wrap ($first_ident, $next_ident, $end_of_line, $max_length,
|
---|
36 | @values);
|
---|
37 |
|
---|
38 | print makefile_wrap ("VARIABLE = ", " ", @values);
|
---|
39 |
|
---|
40 | =head1 DESCRIPTION
|
---|
41 |
|
---|
42 | This modules provide facility to format list of strings. It is
|
---|
43 | comparable to Perl's L<Text::Wrap>, however we can't use L<Text::Wrap>
|
---|
44 | because some versions will abort when some word to print exceed the
|
---|
45 | maximum length allowed. (Ticket #17141, fixed in Perl 5.8.0.)
|
---|
46 |
|
---|
47 | =head2 Functions
|
---|
48 |
|
---|
49 | =over 4
|
---|
50 |
|
---|
51 | =cut
|
---|
52 |
|
---|
53 | # tab_length ($TXT)
|
---|
54 | # -----------------
|
---|
55 | # Compute the length of TXT, counting tab characters as 8 characters.
|
---|
56 | sub tab_length($)
|
---|
57 | {
|
---|
58 | my ($txt) = @_;
|
---|
59 | my $len = length ($txt);
|
---|
60 | $len += 7 * ($txt =~ tr/\t/\t/d);
|
---|
61 | return $len;
|
---|
62 | }
|
---|
63 |
|
---|
64 | =item C<wrap ($head, $fill, $eol, $max_len, @values)>
|
---|
65 |
|
---|
66 | Format C<@values> as a block of text that starts with C<$head>,
|
---|
67 | followed by the strings in C<@values> separated by spaces or by
|
---|
68 | C<"$eol\n$fill"> so that the lenght of each line never exceed
|
---|
69 | C<$max_len>.
|
---|
70 |
|
---|
71 | The C<$max_len> contraint is ignored for C<@values> items which
|
---|
72 | are too big to fit alone one a line.
|
---|
73 |
|
---|
74 | The constructed paragraph is C<"\n">-terminated.
|
---|
75 |
|
---|
76 | =cut
|
---|
77 |
|
---|
78 | sub wrap($$$$@)
|
---|
79 | {
|
---|
80 | my ($head, $fill, $eol, $max_len, @values) = @_;
|
---|
81 |
|
---|
82 | my $result = $head;
|
---|
83 | my $column = tab_length ($head);
|
---|
84 |
|
---|
85 | my $fill_len = tab_length ($fill);
|
---|
86 | my $eol_len = tab_length ($eol);
|
---|
87 |
|
---|
88 | my $not_first_word = 0;
|
---|
89 |
|
---|
90 | foreach (@values)
|
---|
91 | {
|
---|
92 | my $len = tab_length ($_);
|
---|
93 |
|
---|
94 | # See if the new variable fits on this line.
|
---|
95 | # (The + 1 is for the space we add in front of the value.).
|
---|
96 | if ($column + $len + $eol_len + 1 > $max_len
|
---|
97 | # Do not break before the first word if it does not fit on
|
---|
98 | # the next line anyway.
|
---|
99 | && ($not_first_word || $fill_len + $len + $eol_len + 1 <= $max_len))
|
---|
100 | {
|
---|
101 | # Start a new line.
|
---|
102 | $result .= "$eol\n" . $fill;
|
---|
103 | $column = $fill_len;
|
---|
104 | }
|
---|
105 | elsif ($not_first_word)
|
---|
106 | {
|
---|
107 | # Add a space only if result does not already end
|
---|
108 | # with a space.
|
---|
109 | $_ = " $_" if $result =~ /\S\z/;
|
---|
110 | ++$len;
|
---|
111 | }
|
---|
112 | $result .= $_;
|
---|
113 | $column += $len;
|
---|
114 | $not_first_word = 1;
|
---|
115 | }
|
---|
116 |
|
---|
117 | $result .= "\n";
|
---|
118 | return $result;
|
---|
119 | }
|
---|
120 |
|
---|
121 |
|
---|
122 | =item C<makefile_wrap ($head, $fill, @values)>
|
---|
123 |
|
---|
124 | Format C<@values> in a way which is suitable for F<Makefile>s.
|
---|
125 | This is comparable to C<wrap>, except C<$eol> is known to
|
---|
126 | be C<" \\">, and the maximum length has been hardcoded to C<72>.
|
---|
127 |
|
---|
128 | A space is appended to C<$head> when this is not already
|
---|
129 | the case.
|
---|
130 |
|
---|
131 | This can be used to format variable definitions or dependency lines.
|
---|
132 |
|
---|
133 | makefile_wrap ('VARIABLE =', "\t", @values);
|
---|
134 | makefile_wrap ('rule:', "\t", @dependencies);
|
---|
135 |
|
---|
136 | =cut
|
---|
137 |
|
---|
138 | sub makefile_wrap ($$@)
|
---|
139 | {
|
---|
140 | my ($head, $fill, @values) = @_;
|
---|
141 | if (@values)
|
---|
142 | {
|
---|
143 | $head .= ' ' if $head =~ /\S\z/;
|
---|
144 | return wrap $head, $fill, " \\", 72, @values;
|
---|
145 | }
|
---|
146 | return "$head\n";
|
---|
147 | }
|
---|
148 |
|
---|
149 |
|
---|
150 | 1;
|
---|
151 |
|
---|
152 | ### Setup "GNU" style for perl-mode and cperl-mode.
|
---|
153 | ## Local Variables:
|
---|
154 | ## perl-indent-level: 2
|
---|
155 | ## perl-continued-statement-offset: 2
|
---|
156 | ## perl-continued-brace-offset: 0
|
---|
157 | ## perl-brace-offset: 0
|
---|
158 | ## perl-brace-imaginary-offset: 0
|
---|
159 | ## perl-label-offset: -2
|
---|
160 | ## cperl-indent-level: 2
|
---|
161 | ## cperl-brace-offset: 0
|
---|
162 | ## cperl-continued-brace-offset: 0
|
---|
163 | ## cperl-label-offset: -2
|
---|
164 | ## cperl-extra-newline-before-brace: t
|
---|
165 | ## cperl-merge-trailing-else: nil
|
---|
166 | ## cperl-continued-statement-offset: 2
|
---|
167 | ## End:
|
---|