view release on metacpan or  search on metacpan

lib/App/Chart/EmacsMain.pm  view on Meta::CPAN

# remember which latests sent, only give 'update' for them


package App::Chart::EmacsMain;
use 5.010;
use strict;
use warnings;
use Encode;
use Encode::Locale;  # for coding system "locale"
use IO::Handle;
use Lisp::Reader;
use Lisp::Printer ('lisp_print');
use Lisp::Symbol ('symbol');
use POSIX ();
use Regexp::Common 'whitespace';
use Locale::TextDomain 'App-Chart';

use App::Chart;

# set this to 1 for development debugging prints
use constant { DEBUG => 0,
               DEBUG_TTY_FILENAME => '/dev/tty7' };


use constant PROTOCOL_VERSION => 102;
my $emacs_fh;

# reopen $fd on $filename with $omode a POSIX::O_WRONLY() etc value
# return $fd on success, or undef with $! set on error
sub fdreopen {
  my ($fd, $filename, $omode) = @_;
  my $file_fd = POSIX::open ($filename, $omode);
  if (! defined $fd) { return undef; }
  # print "fdreopen $fd $filename, via $file_fd\n";

  if (! defined POSIX::dup2 ($file_fd, $fd)) {
    {
      local $!;
      POSIX::close ($file_fd);
    }
    return undef;
  }
  if (! defined POSIX::close ($file_fd)) { return undef; }
  return $fd;
}

sub main {
  my ($class) = @_;

  # subprocess unbuffered and utf8
  binmode (STDIN, ':utf8') or die;

  # dup-ed to a new descriptor to talk to emacs
  open $emacs_fh, '>&STDOUT' or die;
  $emacs_fh->autoflush(1); # emacs_write() does single-string prints

  # ENHANCE-ME: use one of the IO::Capture or via layer or whatnot to get
  # perl prints to STDOUT/STDERR and send them up to an emacs buffer, or
  # message area
  #
  # stdout/stderr fds 1 and 2 put to /dev/null to discard other prints
  my $devnull = File::Spec->devnull;
  fdreopen (1, $devnull, POSIX::O_WRONLY())
    // die "Cannot send STDOUT to $devnull: ", Glib::strerror($!);
  POSIX::dup2 (1, 2) // die;

  if (DEBUG) {
    # fds 1 and 2 changed (again) to DEBUG_TTY_FILENAME, if it's possible to
    # open that
    if (fdreopen (1, DEBUG_TTY_FILENAME, POSIX::O_WRONLY())) {
      POSIX::dup2 (1, 2) // die "Cannot dup fd 1 to fd 2: $!";

      print "EmacsMain started, emacs_fh fd=",fileno($emacs_fh),
        ", diagnostics on ",DEBUG_TTY_FILENAME,"\n";
      print "  STDOUT fd ",fileno(STDOUT),", STDERR fd ",fileno(STDERR),"\n";
      STDOUT->autoflush(1);
      STDERR->autoflush(1); # probably true already
    }
  }


  # initial message
  emacs_write (symbol('init'), 'UTF-8', PROTOCOL_VERSION);

  my $mainloop = Glib::MainLoop->new;
  STDIN->blocking(0);
  Glib::IO->add_watch (fileno(STDIN), ['in', 'hup', 'err'], \&_do_read,
                       $mainloop);

  $Lisp::Reader::SYMBOLS_AS_STRINGS = 1;

  my $dirb = App::Chart::chart_dirbroadcast();
  $dirb->listen;
  $dirb->connect ('delete-symbol', \&completions_update);
  $dirb->connect ('symlist-content-changed',  \&_do_symlist_content_changed);
  $dirb->connect ('symlist-content-inserted', \&_do_symlist_content_inserted);
  $dirb->connect ('symlist-content-deleted',  \&_do_symlist_content_deleted);
  $dirb->connect ('symlist-content-reordered',\&_do_symlist_content_reordered);
  $dirb->connect ('symlist-list-changed',     \&_do_symlist_list_changed);

  $dirb->connect ('latest-changed', \&send_update);
  $dirb->connect ('data-changed', \&send_update);

  Glib->install_exception_handler (\&exception_handler);
  ## no critic (RequireLocalizedPunctuationVars)
  $SIG{'__WARN__'} = \&exception_handler;
  $mainloop->run;
}

# 'data-changed' and 'latest-changed'
sub send_update {
  my ($changed) = @_;
  if (DEBUG) { print "Changed: ",join(' ',keys %$changed),"\n"; }
  emacs_write (symbol('update'), [ keys %$changed ]);

  # this is a bit excessive, only really want to know if new symbols have
  # been added to the latest quotes
  completions_update();
}

sub exception_handler {