view release on metacpan or  search on metacpan

lib/Emacs.pm  view on Meta::CPAN

    if (! defined ($real_pid)) {
	$real_pid = $$;
    }
    tie ($$, 'Emacs::PID');

    $stuff_tied = 1;
}

sub cleanup {
    return if ! $stuff_tied;

    untie ($$);
    untie (%SIG) if ref (tied (%SIG)) eq 'Emacs::SIG';
    untie (%ENV) if ref (tied (%ENV)) eq 'Emacs::ENV';

    $SIG{'__WARN__'} = $old_warner if $SIG{'__WARN__'} eq 'Emacs::SIG__WARN__';

    untie (*STDERR) if ref (tied (*STDERR)) eq 'Emacs::Minibuffer';
    untie (*STDOUT) if ref (tied (*STDOUT)) eq 'Emacs::Stream';
    untie (*STDIN) if ref (tied (*STDIN)) eq 'Emacs::Minibuffer';

    $stuff_tied = 0;
}

sub main {
    if (! defined (&_main)) {
	Carp::croak ("main() won't work, use \@Emacs::args instead");
    }
    package main;
    if (@_) {
	return Emacs::_main (@_);
    } else {
	return Emacs::_main ($0, @ARGV);
    }
}

sub SIG__WARN__ {
    my $msg = shift;
    chomp $msg;
    print STDERR $msg;
}

sub exit {
    my ($status) = @_;

    local $SIG{'__WARN__'} = 'DEFAULT';
    if ($Emacs::current) {
	&Emacs::Lisp::kill_emacs ($status);
    }
    CORE::exit ($status);
}


package Emacs::ENV;

sub TIEHASH {
    return (bless (\ do { my $x }, $_[0]));
}

sub FETCH	{ return &Emacs::Lisp::getenv ($_[1]); }
sub STORE	{ &Emacs::Lisp::setenv ($_[1], $_[2]); return ($_[2]); }

# XXX Need to write tests for these.

sub DELETE	{ &Emacs::Lisp::setenv ($_[1], undef); }
sub EXISTS	{ return defined (FETCH (@_)); }

sub FIRSTKEY {
    my ($pe, $str);

    $pe = Emacs::Lisp::Object::symbol_value (\*::process_environment);
    return undef if $pe->is_nil;
    $str = $pe->car->to_perl;
    $str =~ s/=.*//s;
    return $str;
}

sub NEXTKEY {
    my ($self, $lastkey) = @_;
    my ($tail, $str);

    for ($tail = Emacs::Lisp::Object::symbol_value (\*::process_environment);
	 not $tail->is_nil;
	 $tail = $tail->cdr)
    {
	if ($tail->car->to_perl =~ /^\Q$lastkey\E=/s) {
	    $tail = $tail->cdr;
	    return undef if $tail->is_nil;
	    $str = $tail->car->to_perl;
	    $str =~ s/=.*//s;
	    return $str;
	}
    }
    return undef;
}

sub CLEAR { &Emacs::Lisp::set (\*::process_environment, undef); }


package Emacs::Stream;

use vars ('@ISA');
@ISA = ('Tie::Handle');

sub TIEHANDLE {
    return (bless (\ do { my $x = $_[1] }, $_[0]));
}

sub WRITE {
    my ($stream, $output, $length, $offset) = @_;
    Emacs::Lisp::princ (substr ($output, $offset, $length),
			Emacs::Lisp::symbol_value ($$stream));
    return ($length);
}

sub PRINT {
    my ($stream, @items) = @_;
    Emacs::Lisp::princ (join ('', @items),
			Emacs::Lisp::symbol_value ($$stream));
    return (1);
}


package Emacs::Minibuffer;