view release on metacpan or  search on metacpan

examples/xmailfolder.pl  view on Meta::CPAN

    if (!defined($composetemplates{$Options{'DefaultComposeTemplate'}}));
  my $templatefile = $composetemplates{$Options{'DefaultComposeTemplate'}};
  $templatefile = expand_filename($templatefile);
  unless ($templatefile && -f $templatefile) {
    $use_tmp++;
    $fh = new IO::File ">$tmpfile" or croak("can't create $tmpfile: $!\n");
    for my $tag ('To: ', 'Cc: ', 'From: ', 'Subject: ', '') {
      $fh->print("$tag\n");
    }
    $fh->close;
    $templatefile = $tmpfile;
  }
  $fh = new IO::File $templatefile or croak("can't open $templatefile: $!\n");
  $mref = new Mail::Internet $fh;
  $mref->tidy_body;
  $fh->close;
  unlink $templatefile if ($use_tmp);

  my $compose = new Compose($mref);
}
###############################################################################
sub bump_counter { return $counter++; }

sub gen_tmp_filename {
  return get_tmpdir() . "/xmf." . bump_counter() . ".$$";
}

sub expand_filename {
  my $filename = shift;
  $filename =~ s/^~\//$ENV{HOME}\//;
  return $filename;
}
###############################################################################
sub ShowVersion {
  my ($top) = @_;
  my $d = $top->Dialog(-title => 'Versions',
		       -popover => $top,
		       -image => $camel,
		       -text => "X-MailFolder: $VERSION\nAuthor: Kevin Johnson <kjj\@pobox.com>\nTk: $Tk::patchLevel\nLibrary: $Tk::library\nperl/Tk: $Tk::VERSION\nperl: $]",
		       -justify => 'center',
		       -font => '-*-Times-Medium-R--Normal-*-120-*-*-*-*-*-*',
		      );
  $d->Show
}
###############################################################################
sub CleanQuit {
  foreach my $folder (keys %{$foldersinfo}) {
    if ($foldersinfo->{$folder}{Status} eq 'open') {
      $foldersinfo->{$folder}{Status} = 'closed';
      $foldersinfo->{$folder}{Folder}->close;
    }
  }
  exit 0;
}
###############################################################################
sub get_tmpdir { return $ENV{TMPDIR} || '/tmp'; }

sub get_username {
  my $username;
  
  $username = $ENV{USER} || $ENV{LOGNAME} || (getpwuid($>))[6];
  unless (defined($username)) {
    croak("can't determine user name!");
    exit 1;
  }
  return $username;
}

sub get_option {
  my $key = shift;
  return undef if (!defined($Options{$key}));
  return $Options{$key};
}

sub createMyListbox {
  my $top = shift;
  my $retval;
  my $lb;
  
  $retval = $top->ScrlListbox(@_);
  $lb = $retval->Subwidget('listbox');
  $lb->bindtags([$lb, 'Tk::ListBox', $top, 'all']);
  $lb->bind('<Down>' => sub {
	      $lb->activate($lb->index('active')+1);
	      $lb->see('active');
	    });
  $lb->bind('<Up>' => sub {
	      $lb->activate($lb->index('active')-1);
	      $lb->see('active');
	    });
  $lb->bind('<Control-Home>' => sub {
	      $lb->activate(0);
	      $lb->see(0);
	    });
  $lb->bind('<Control-End>' => sub {
	      $lb->activate('end');
	      $lb->see('end');
	    });
  $lb->bind('<ButtonRelease-1>' => sub {
	      my $Ev = $lb->XEvent;
	      $lb->CancelRepeat;
	      $lb->activate($Ev->xy);
	    });
  $lb->bind('<Next>' => ['yview', 'scroll', 1, 'pages']);
  $lb->bind('<Prior>' => ['yview', 'scroll', -1, 'pages']);
  
  $lb->bind('<Left>' => ['xview', 'scroll', -1, 'units']);
  $lb->bind('<Control-Left>' => ['xview', 'scroll', -1, 'pages']);
  $lb->bind('<Control-Prior>' => ['xview', 'scroll', -1, 'pages']);
  $lb->bind('<Right>' => ['xview', 'scroll', 1, 'units']);
  $lb->bind('<Control-Right>' => ['xview', 'scroll', 1, 'pages']);
  $lb->bind('<Control-Next>' => ['xview', 'scroll', 1, 'pages']);
  $lb->bind('<Home>' => ['xview', 'moveto', 0]);
  $lb->bind('<End>' => ['xview', 'moveto', 1]);
  
  return $retval;
}
###############################################################################
package Folder;

BEGIN { import Compose; }