view release on metacpan or  search on metacpan

lib/Emacs/Lisp.pm  view on Meta::CPAN

	my ($type, $name) = ($1, $2);
	if ($type eq '%') {
	    next if tied %$name;
	    tie %$name, 'Emacs::Lisp::Plist', \*{"::$name"};
	} else {
	    next if tied $$name;
	    tie $$name, 'Emacs::Lisp::Variable', \*{"::$name"};
	}
	push @newlist, $_[$i];
    }
    # XXX  Accommodating some undocumented Exporter.pm behavior here...
    if (%EXPORT) {
	@EXPORT{@newlist} = (1) x @newlist;
    } else {
	push @EXPORT_OK, @newlist;
    }
    goto &Exporter::import;
}

# Normally, one does not export an AUTOLOAD sub by default.
# But presumably, if you're using this module, you are running Emacs
# and want easy access to Lisp functions.
# Say `use Emacs::Lisp ();' to avoid importing AUTOLOAD.
#
# XXX Regardless, this should probably be fixed to insert AUTOLOAD
# as a closure/hook if there already is one.  Maybe the place to fix
# it is in Exporter.pm. (?)

%EXPORT_TAGS =
    (
     funcs	=> [qw(
		       funcall
		       AUTOLOAD
		       cons
		       consp
		       car
		       cdr
		       setcar
		       setcdr
		       )],
     special	=> [qw(
		       catch
		       defun
		       interactive
		       save_current_buffer
		       save_excursion
		       save_restriction
		       setq
		       track_mouse
		       unwind_protect
		       )],
     extra	=> [qw(
		       lisp
		       t
		       nil
		       )],
     );

@EXPORT = map { @$_ } values %EXPORT_TAGS;

sub t () { return \*::t; }
sub nil () { return undef; }

sub AUTOLOAD {
    *$AUTOLOAD = &$get_funcall_closure (__PACKAGE__, $AUTOLOAD);
    goto &$AUTOLOAD;
}
sub can { return &UNIVERSAL::can || &$can (__PACKAGE__, $_[1]); }

%special =
    (
     'setq_default'	=> "use `&set_default(\\*::symbol, \$value)' instead",
     'or'		=> "use Perl's `or' or `||' operator instead",
     'and'		=> "use Perl's `and' or `&&' operator instead",
     'if'		=> "use Perl's `if' or `?...:' operator instead",
     'cond'		=> "use Perl's `if', `elsif' and `else' instead",
     'progn'		=> "use a code block instead",
     'prog1'		=> "use a temporary variable instead",
     'prog2'		=> '*prog1',
     'quote'		=> "use `\\*::symbol' to quote a symbol, and "
			     . "`[\@items]' to make a list",
     'function'		=> '*quote',
     'defmacro'		=> "functionality to be added",
     'defvar'		=> "functionality to be added",
     'defconst'		=> '*defvar',
     'let*'		=> '*let',
     'let'		=> "use `local' instead",
     'while'		=> "use Perl's `for', `while' or `until' instead",
     'condition_case'	=> "use Perl's `eval' instead",
     'ml_if'		=> undef,
     'eval_when_compile'=> "use a `BEGIN' block or Perl's `use' instead",
  );

sub setq (&) {
    if (! HAVE_B()) {
	warn ("This version of Perl can't do setq.  Import explicitly");
	# But try anyway.
	return (&{$_[0]}());
    }

    my $coderef = shift;
    my $callpkg = caller;
    my @vars = _assignees($coderef);
    local $Exporter::ExportLevel = 1;
    import Emacs::Lisp @vars;
    return (&$coderef);
}

my (@_assignees);

sub _assignees ($) {
    return unless HAVE_B();
    my ($coderef) = @_;

    # What an irony that the B module is not conducive to thread-safety!
    # (or am I missing something?)
    # Well, you're toast if you are defunning from multiple threads anyway.
    @_assignees = ();

    B::walkoptree (B::svref_2object ($coderef)->ROOT,
		   'Emacs__Lisp_push_op_assignees');