#!/usr/bin/perl -w
use strict;
use Getopt::Long;
use Pod::Usage;

$|++;
my $diary = "$ENV{HOME}/diary";
my ($month, $year) = (localtime)[4,5]; $month++; $year+=1900;
my $num_months = 1;
my $filebase = "temporary_calendar_file_DeleteMe";
my $cleanup = 1;
my $print = 1;
my $printer = '';
my ($help, $pdf, $ps);

#BEGIN: qbash
sub qbash($) {
  local $_ = shift;
  die "Unquotable expression: $_" if /[^[:print:]\s]/;
  #    Should be: \pL\pM\pN\pP\pS\pZ[:print:]\s   (but we don't have unicode everywhere)
  # equivalently: \p{Letter}\p{Mark}\p{Number}\p{Punctuation}\p{Symbol}\p{Separator}
  #          was: [:print:]\s
  s/'/'\\''/g; /^(.*)$/s and return "'$1'";
}
#END: qbash

#BEGIN: SYSTEM, 1 line; depends: qbash
sub SYSTEM { system join " ", map( ((ref($_)eq'SCALAR') ? $$_ : &qbash($_)), @_ ) }

#BEGIN: QX, 1 line; depends: qbash
sub QX { my $x = join " ", map( ((ref($_)eq'SCALAR') ? $$_ : &qbash($_)), @_ ); qx"$x" }


#                          Parse Options
Getopt::Long::Configure ('bundling');
GetOptions ('help|?|h'             => \$help,
            'f=s'                  => \$filebase,
            'd=s'                  => \$diary,
	    'n=i'                  => \$num_months,
            'm=i'                  => \$month,
            'y=i'                  => \$year,
            'P=s'                  => sub{ $printer = "-P $_[1]" },
            'no-print'             => sub{ $print = 0; },
            'print'                => \$print,
            'pdf'                  => \$pdf,
            'ps'                   => \$ps,
            'cleanup'              => \$cleanup,
            'no-cleanup'           => sub{ $cleanup = 0; },
	   );

#                      Give help if requested
pod2usage(1) if $help;

# Need to prevent emacs from croaking.
unless (defined $diary and -f $diary) {
  system "touch", "$filebase.diary";
  $diary = "$filebase.diary";
}
$ps = 1 unless $pdf;

open ELISP, ">", "$filebase.el";
print ELISP <<END_OF_EMACS;
(setq list-diary-entries-hook '(include-other-diary-files))
(setq mark-diary-entries-hook '(mark-included-diary-files))
(add-hook `cal-tex-diary' t)
(add-hook `cal-tex-holidays' t)
(setq diary-file "$diary")

(calendar)
(mark-calendar-holidays)
(mark-diary-entries)
(calendar-other-month $month $year)
(cal-tex-cursor-month-landscape $num_months)
(write-file "$filebase.tex")
END_OF_EMACS
close ELISP;

print "Calling Emacs..."; SYSTEM qw/emacs -batch -l/, "$filebase.el" \">/dev/null 2>/dev/null"; print "done\n";
print "Running LaTeX..."; SYSTEM "latex", "\\nonstopmode\\input{$filebase}", \">/dev/null"; print "done\n";
if ($ps) {
  print "Running Dvips..."; SYSTEM qw/dvips -tlandscape/, "$filebase.dvi", "-o", "$filebase.ps", \">/dev/null 2>/dev/null"; print "done\n";
}
if ($pdf) {
  print "Running Dvipdf..."; SYSTEM "dvipdf", "$filebase.dvi", "$filebase.ps"; print "done\n";
}

qx|lpr $printer $filebase.ps| if $print;

if ($cleanup) { qx| rm -f $filebase.$_ | for qw/tex el dvi log aux tex~ diary/ }
if ($cleanup and $print) { qx| rm -f $filebase.$_ | for qw/ps/ }

__END__

=pod

=head1 NAME

print-calendar - Print pretty monthly calendars using emacs diary

=head1 SYNOPSIS

 print-calendar [options]

 Options:
  -?, -h, --help        brief help message

  -d <filename>         diary file to include
                          DEFAULT = $HOME/diary

  -f <name>             base filename to use
                          DEFAULT = temporary_calendar_file_DeleteMe

  -m <num>              first month to print (a number from 1 to 12)
                          DEFAULT = current month

  -n <num>              number of months to print
                          DEFAULT = 1

  -y <num>              the year of the first month to print
                          DEFAULT = current year

  --print               send the calendar to lpr
  --no-print            save a PostScript file instead
                          DEFAULT --print

  -P <printer>          use a specific printer
                          DEFAULT = the default printer

  --cleanup             erase temporary files used in creating the output
  --no-cleanup          do not erase the temporary files
                          DEFAULT = --cleanup

=head1 AUTHOR

 Dean Serenevy
 dean@cs.serenevy.net
 http://dean.serenevy.net

=head1 COPYRIGHT

Copyright (c) 2003 Dean Serenevy. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=head1 SEE ALSO

perl(1).

=cut