]>
code.delx.au - gnu-emacs-elpa/blob - packages/notes-mode/mkprevnext
5 # $Id: mkprevnext,v 1.22 2007/02/23 05:15:17 johnh Exp $
7 # Copyright (C) 1994-1996,2012 Free Software Foundation, Inc.
8 # Comments to <johnh@isi.edu>.
10 # This file is under the Gnu Public License.
15 usage: $0 [-X] indexfile [FILE...]
16 Update the prev and next pointers in [file...]
19 We assume that indexfile is sorted.
21 Option: -X means read the filesname from stdin rather than the command line.
23 To update prev/next pointers do:
24 ./mkprevnext ./index 9?????
32 my($files_from_stdin) = undef;
33 if ($ARGV[0] eq '-X') {
34 $files_from_stdin = 1;
37 &usage
if ($#ARGV < 0);
39 %direction_delta = split(/ +/, 'prev -1 next 1');
50 if ($files_from_stdin) {
60 # Read the index file.
61 # Build links of in $index{"$file#$subject","$prevnext"}.
62 # Assumes that the index is sorted.
65 local($indexfile) = @_;
66 local ($file, $subject);
67 local (@old_sort_order, @sort_order);
68 local($filesubject, $prevfilesubject) = ('', '');
71 warn("$0: aborted. $indexfile is zero length.\n");
74 open(INDEX
,"<$indexfile") || die("Cannot open $indexfile");
76 ($prevurl, $prevfile, $prevsubject) = ("", "", "");
77 @sort_order = ("") x
3;
81 ($filehead, $file, $subject) = /^(.*)\/([^#]*)\#(.*)$/;
82 # Sigh, have to fold things to upper case since sort only
83 # does that, not to lower case.
84 $filehead = uc($filehead);
86 $subject = uc($subject);
87 $filesubject = "$file#$subject";
90 die ("Bad index entry: $_") if (!defined($file) || !defined($subject));
91 @old_sort_order = @sort_order;
92 @sort_order = ($subject, $filehead, $file);
93 foreach $i (0..$#sort_order) {
94 last if ($sort_order[$i] gt $old_sort_order[$i]);
95 die ("Index is not in sorted order (entries $i).\n\t$sort_order[$i]\n\t$old_sort_order[$i]\n")
96 if ($sort_order[$i] lt $old_sort_order[$i])
99 # Skip repeated entries.
100 if ($filesubject eq $prevfilesubject) {
101 $count_i{$filesubject}++;
106 $url_i{$filesubject} = $url;
107 if ($prevsubject eq $subject) {
108 $link_i{$filesubject,'prev'} = $prevfilesubject;
109 $link_i{$prevfilesubject,'next'} = $filesubject;
111 $link_i{$filesubject,'prev'} = 'none';
112 $link_i{$prevfilesubject,'next'} = 'none';
114 # Count entries per-file.
115 $count_i{$filesubject} = 1;
116 ($prevurl, $prevfile, $prevsubject, $prevfilesubject) =
117 ($url, $file, $subject, $filesubject);
119 # Close the last pointer and hacks for null pointers.
120 $link_i{$prevfilesubject,'next'} = 'none';
121 $url_i{'none'} = 'none';
122 $count_i{'none'} = 1;
128 # Go through a particular file
129 # and update its prev/next pointers.
132 local ($fullfile) = @_;
133 local (@data, $change, $mode, $subject);
134 local ($mode_lookheader, $mode_expectdash, $mode_expectprev, $mode_expectnext) = (0..99);
136 local (@data, $data, $error);
137 local ($subject_length, $found_expected_label);
138 local (%subject_count) = ();
140 local($file) = ($fullfile);
141 $file =~ s@
.*/([^/]+)@
$1@
; # basename
143 open(FILE
,"<$fullfile") || die("Cannot open $file");
148 $mode = $mode_lookheader;
150 # Scan through the file, looking for headers.
151 # There is some context senstivity using $mode.
154 if ($mode == $mode_lookheader) {
162 $filesubject = "$file#$subject";
164 $subject_length = length($_) - 1;
165 $subject_count{$subject}++;
166 $mode = $mode_expectdash;
169 } elsif ($mode == $mode_expectdash) {
171 # Check and fix dash length.
172 if (length($_)-1 != $subject_length) {
173 $_ = ("-" x
$subject_length) . "\n";
177 $mode = $mode_expectprev;
180 # warn("warning: subject <$subject> missing dashes in $file.\n") if (!/^\*/);
182 $mode = $mode_lookheader;
185 } elsif ($mode == $mode_expectprev) {
186 $found_expected_label = (/^prev: \<(.*)\>$/) ?
1 : 0;
187 push (@data, &new_link
('prev', $file, $subject, $subject_count{$subject}));
188 $change++ if (!$found_expected_label ||
189 ($found_expected_label && $data[$#data] ne $_));
190 $mode = $mode_expectnext;
191 if ($found_expected_label) { next; } else { redo; };
192 } elsif ($mode == $mode_expectnext) {
193 $found_expected_label = (/^next: \<(.*)\>$/) ?
1 : 0;
194 push (@data, &new_link
('next', $file, $subject, $subject_count{$subject}));
195 $change++ if (!$found_expected_label ||
196 ($found_expected_label && $data[$#data] ne $_));
197 $mode = $mode_lookheader;
198 if ($found_expected_label) { next; } else { redo; };
200 die ("bad mode: $mode");
202 die("end of loop reached unexpectedly.");
206 return if (!$change);
208 warn("Updating file $file.\n") if ($verbose);
209 warn(" writing backup file ${fullfile}~.\n") if ($verbose);
210 open(BFILE
, ">$fullfile~") || die("Cannot write backup file $fullfile~.\n");
211 $data = join("", @olddata);
212 $error = syswrite(BFILE
, $data, length($data));
213 die("Backup file failed.\n") unless ($error = length($data));
215 open (FILE
, ">$fullfile") || goto abort
;
216 $data = join("", @data);
217 $error = syswrite(FILE
, $data, length($data));
218 goto abort
unless ($error == length($data));
219 close (FILE
) || goto abort
;
223 close (FILE
); # ignore error
224 warn ("Aborting changes to file $file.\n");
225 rename("$fullfile~", "$fullfile") ||
226 die("Could not back-out changes to $file. Old data saved in $file~.");
232 local ($direction, $file, $subject, $srcposition) = @_;
233 local($filesubject) = "$file#$subject";
236 # First handle ignorance.
237 return &format_url
($direction,'none')
238 if (!defined($link_i{$filesubject,$direction}));
240 # See if we're in the same file.
241 if (($direction eq 'prev' && $srcposition > 1) ||
242 ($direction eq 'next' && $srcposition < $count_i{$filesubject})) {
244 return &format_url
($direction, $url_i{$filesubject},
245 $srcposition + $direction_delta{$direction});
248 # In a different file. Does the other file have multple entries?
249 $other_count = $count_i{ $link_i{$filesubject,$direction} };
250 if ($other_count != 1) {
252 return &format_url
($direction,
253 $url_i{ $link_i{$filesubject,$direction} },
254 ( $direction eq 'prev' ?
$other_count : 1));
257 # Different file with only one entry.
258 return &format_url
($direction,
259 $url_i{ $link_i{$filesubject,$direction} } );
265 local($direction, $url, $count) = @_;
266 $url =~ s/\#\*/#$count*/ if (defined($count));
267 return "$direction: <$url>\n";
270 ## substutite for "uc", if you want to back-port to perl4.