3 # Copyright (C) 2000-2008 Simon Huggins
4 # merge merges the sig and the tag but also merges the sig and the new style
5 # plugin things (i.e. all those silly files in $cfg{'tmpdir'}
7 # This program is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by the Free
9 # Software Foundation; either version 2 of the License, or (at your option)
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 # You should have received a copy of the GNU General Public License along
18 # with this program; if not, write to the Free Software Foundation, Inc., 59
19 # Temple Place, Suite 330, Boston, MA 02111-1307 USA
25 $Text::Wrap::columns=defined $cfg{'maxlinelen'} ? $cfg{'maxlinelen'} : 72;
27 $cfg{'leader'} ||= "";
29 # Work out the correct locale to use if there is one otherwise we assume
30 # UTF-8 which shouldn't kill ascii people and anyone else should have
31 # correctly set locale.
32 my $fromcharset = 'UTF-8';
33 my $tocharset = 'UTF-8';
35 my @all_encodings = Encode->encodings(":all");
37 if (defined $ENV{'LC_ALL'}) {
38 $locale = $ENV{'LC_ALL'};
39 } elsif (defined $ENV{'LC_CTYPE'}) {
40 $locale = $ENV{'LC_CTYPE'};
41 } elsif (defined $ENV{'LANG'}) {
42 $locale = $ENV{'LANG'};
47 foreach (@all_encodings) {
48 if ($locale eq lc $_) {
49 $tocharset = $fromcharset = $_;
55 my $anal_merge_debug=0;
60 # Remove whitespace at the end of lines but not newlines themselves.
61 # And don't remove the space if it comes directly after a -- which is
62 # anchored at the beginning of a line.
64 $text =~ s/(?<!^--)[ ]*$//mg;
66 # Remove any newlines from the very end of the string.
79 my ($plugin,$len,$align,$wascr);
82 while ($sig =~ /@([A-Za-z]?)(\*|(?:[1-9][0-9]*))([RC]?)@/) {
88 } elsif (not defined $2) {
92 } elsif ($2 =~ /^[RC]$/) {
102 print STDERR "plugin,len,type = #$plugin#,#$len#,#$align#\n" if $anal_merge_debug;
104 $chunk = getplugin($plugin);
105 print STDERR "Got plugin $plugin and $chunk\n"
106 if $anal_merge_debug;
107 $len = quotemeta $len; # escape * if it is *
108 $sig =~ s/\@$plugin$len[RC]?@/$chunk/;
109 print STDERR "Sig is now:\n$sig" if $anal_merge_debug;
115 $chunk = substr $tag, 0, $len;
116 print STDERR "chunk,tag = #$chunk#,#$tag#".length($tag)." ".length($chunk)."\n"
117 if $anal_merge_debug;
118 if ($chunk =~ s/^([^\n]+)\n+(.*)$/$1/s) {
120 print STDERR "\$extra = [$extra]\n"
121 if $anal_merge_debug;
123 if (length($chunk) < $len) {
124 print STDERR "length(chunk) < $len\n"
125 if $anal_merge_debug;
126 $chunk=&chunksizealign($chunk,$len,$align);
127 print STDERR "chunk = #$chunk#\n"
128 if $anal_merge_debug;
130 if (length($tag) < $len + 1) {
131 $tag= $extra ? $extra : "";
132 print STDERR "length(tag) < $len + 1, tag now = #$tag#(extra = #$extra#)\n"
133 if $anal_merge_debug;
134 } elsif (substr $tag, 0, $len + 1 eq ' ') {
135 $tag=substr $tag, $len + 1;
136 $tag=$extra . $tag if defined $extra;
137 print STDERR "substr tag, 0, $len + 1 was a space. tag now = #$tag#\n"
138 if $anal_merge_debug;
140 $tag=substr $tag, $len;
141 ### Back up a word in $chunk
142 $tag=$extra . $tag if defined $extra;
143 print STDERR "didn't break at space. Backing up word. tag now = #$tag#\n"
144 if $anal_merge_debug;
145 if ($chunk =~ s/(.*) (.*)$/$1/) {
147 $chunk=&chunksizealign($chunk,$len,$align);
149 print STDERR "If space in chunk then change chunk and add word to tag.".
150 "Reformat chunk now = #$chunk# (tag = #$tag#)\n" if $anal_merge_debug;
156 $len = quotemeta $len; # escape * if it's *
157 $sig =~ s/\@$plugin$len[RC]?@/$chunk/;
160 $sig =~ s/@([0-9]+)[RC]?@/" " x $1/eg;
161 $sig =~ s/@\*[RC]?@//g;
162 $cfg{'notag'} = $notag;
163 if ($tag and not $notag) {
166 return &remove_space($sig);
175 $count = $plugins{$plugin} if defined $plugins{$plugin};
176 open(IN, "$cfg{'tmpdir'}/$plugin") or htagdie "$0: Could not open $cfg{'tmpdir'}/$plugin: $!\n";
182 $plugins{$plugin} = $count+1;
190 my ($tag,$sig,$newsig);
191 open(SIG, "<$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
193 $sig .= decode($fromcharset, $_);
197 if (grep { /\@NOTAG\@/ } $sig) {
200 $sig =~ s/\@NOTAG\@\n//;
202 open(TAG, "<$cfg{'tmptagfile'}") or htagdie "$1: Could not open $cfg{'tmptagfile'}: $!\n";
204 $tag .= decode($fromcharset, $_);
208 if (defined $sig and $sig =~ /@[A-Za-z]?\*|(?:[1-9][0-9]*)[RC]?@/) {
209 $sig = merge($tag,$sig);
211 my $formatted_tag = Text::Wrap::wrap($cfg{'first'},$cfg{'leader'},$tag);
212 $sig .= $formatted_tag;
213 $sig = &remove_space($sig);
217 $sig = encode($tocharset, $sig);
218 open(SIG, ">$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
219 print SIG "\n" while $cfg{'newline'}--;