#!/usr/bin/perl # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # #DESCRIPTION # abcjoin - combine ABC files # #SYNOPSIS # abcjoin file... # #DESCRIPTION # Join a list of ABC files into a single file. The tunes will be separated # by a blank line, and will be numbered consecutively if they don't have # distinct X: index numbers already. # # The result is written to standard output. # #OPTIONS # # # +C Capitalize first letter of titles. # # +H # Incorporate the header file . If it exists, we will read it in, and # we will also generate %% directives that tell abc2ps to center its title # and then put subsequent titles at the left. # # +R # +R # Renumber the tunes. # The tunes will be renumbered consecutively, starting from X:, or X:1 # if no starting index is given. The default is -R, which also renumbers, # but only when the input X: indexes aren't increasing. So if the input # tunes are already numbered in increasing order, the default will use # their numbers. # # +S # Generate separator lines. # This is done with the abc2ps %%sep directive. At present, there # is no way to specify the parameters. # # -W # -w # These control whether W: and w: lines are included in the output. # By default, both are true, and everything in included. # #BUGS # The output X: numbers will be distinct. This is a feature. # # We never read from standard input. Maybe we should add an option # to do this. # #AUTHOR # John Chambers http://trillian.mit.edu/~jc/ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # $| = 1; ($P = $0) =~ s".*/""; $V = $ENV{"V_$P"} || 1; $Xlast = -1; # Last index written $Xnext = 0; # Next index to write $cont = 0; # Previous line continued # Default values of options: $renum = 0; # Renumber the tunes $wout = 1; # Output w: lines $Wout = 1; # Output W: lines for $f (@ARGV) { &outtune("#$P: arg='$f'") if $V>3; if (($flg,$opts) = ($f =~ /^([-+])(.*)/i)) { &outtune("#$P: flg=$flg' opts='$opts'") if $V>2; while ($opts =~ s/^(.)//) { $OPT = uc($opt = $1); &outtune("#$P: OPT='$OPT' opt='$opt'") if $V>2; if ($OPT eq 'C') { $UCT = ($flg eq '+') ? 1 : 0; # Upper-case first letter of title &outtune("#$P: UCT=$UCT.") if $V>1; } elsif ($OPT eq 'S') { $sep = ($flg eq '+') ? 1 : 0; # Generate separators &outtune("#$P: sep=$sep.") if $V>1; } elsif ($OPT eq 'H') { $hopt = ($flg eq '-') ? 0 : 1; # Look for header file &outtune("#$P: hopt=$hopt.") if $V>2; if (open(F,$opts) # Look for the header file || open(F,"hdr/$opts.hdr") || open(F,"$opts.hdr")) { # Can we read it? $hfile = 1; &onefile(); # Copy it to output $hfile = 0; $opts = ''; } else { print STDERR "#$P: Can't read \"$opts\" ($!)\n" if $V>1; } } elsif ($OPT eq 'N' || $OPT eq 'R') { $opts =~ s/^(\d*)//; # Look for starting index number $Xnext = ($1 ne '') ? $1 : 1; # Set next index $Xlast = $Xnext - 1; # Fake "last" index $renum = ($flg eq '+') ? 1 : 0; # Renumber the tunes. &outtune("#$P: ren=$renum Xlast=$Xlast Xnext=$Xnext.") if $V>2; } elsif ($opt eq 'W') { $Wout = ($flg eq '+') ? 1 : 0; # Whether to include W: lines &outtune("#$P: Wout=$Wout.") if $V>1; } elsif ($opt eq 'w') { $wout = ($flg eq '+') ? 1 : 0; # Whether to include w: lines &outtune("#$P: wout=$wout.") if $V>1; } else { print STDERR "#$P: Unknown option '$opt'\n" if $V>0; } } } elsif (open(F,$f)) { if ($last && $files) { &outtune("") unless $hopt; } &onefile(); } else { print STDERR "#$P: Can't read \"$f\" [$~]\n"; } } exit 0; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub onefile { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Read one file and copy it to output. It must be the file F, which was # # opened by the caller. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # local($l,$T,$X); $last = ''; while ($l = ) { # Read the file one line at a time $l =~ s/\s+$//; # Trim trailing white space if ($l || $last) { if ($cont) { if ($lasttype eq 'W:') { &outtune($l) if $Wout; if ($l =~ /\\\s*$/) {$cont = 1} else {$cont = 0} next; } elsif ($lasttype eq 'w:') { &outtune($l) if $wout; if ($l =~ /\\\s*$/) {$cont = 1} else {$cont = 0} next; } else { } } else { $lasttype = ''; } # $l =~ s/^(\w:)\s*/$1 /; # Adjust spacing after : if ($l =~ /\\\s*$/) {$cont = 1} else {$cont = 0} if ($l =~ /^X:\s*(\d+)/) { # X: line $lasttype = 'X:'; $X = $1; $Xnext = $renum ? $Xlast+1 : ($X <= $Xlast) ? $Xlast+1 : $X; &outtune("% X=$X Xnext=$Xnext Xlast=$Xlast") if $V>3; &outtune("\n%%sep 1 1 500") if $sep && $tunes; $l = "X: $Xnext"; &outtune("\n$l") unless $hopt && $tunes; $Xlast = $Xnext; # Remember this tune index if ($Xnext <= $Xlast) {$Xnext = $Xlast + 1} &outtune("% Xnext=$Xnext Xlast=$Xlast") if $V>2; ++$tunes; } elsif ($l =~ /^T:\s*(.+)/) { # T: line $lasttype = 'T:'; if (!defined($X)) { $X = 0; &outtune("\nX: 0"); } &outtune("%T $1") if $V>2; if (!defined($T) || (!$hopt) || $hfile) { &outtune("% Copy title because T not defined.") if !defined($T) && $V>2; &outtune("% Copy title in header file.") if $hfile && $V>2; &outtune("% Copy title because no H option.") if !$hopt && $V>2; $T = $1; # Only do first title for non-header files $T =~ s/^(\w)/\U$1/ # Capitalize first letter in title if $UCT; if ($hfile || !$hopt) { &outtune("T: $T"); # Use regular title line. } else { &outtune("P: $T"); # Convert title to "part" name. } } } elsif ($l =~ /^W:\s*(.+)/) { # W: line $lasttype = 'W:'; &outtune($l) if $Wout; } elsif ($l =~ /^w:\s*(.+)/) { # w: line $lasttype = 'w:'; &outtune($l) if $wout; } else { &outtune($l); } } $last = $l; } ++$files; } sub outtune { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # local($l); for $l (@_) { $l = '%' if $hopt && !$l; print "$l\n"; } }