From 0d246f273a20c9bdeb4f2fa54b744f6201a866b6 Mon Sep 17 00:00:00 2001 From: seanorourke Date: Fri, 21 Apr 2006 01:39:30 +0000 Subject: [PATCH] version 0.59 --- ChangeLog | 6 ++ Makefile | 116 ++++++++++++++++---------------- Makefile.PL | 2 +- README | 23 +++---- Sepia.pm | 166 +++++++++++++++++++++++----------------------- Xref.pm | 8 +-- package.sh | 3 +- sepia-ido.el | 6 +- sepia.el | 212 +++++++++++++++++++++++++++++++++-------------------------- 9 files changed, 284 insertions(+), 258 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1aef395..0204dca 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2006-04-14 Sean O'Rourke + + * generic-repl.el: replaced by comint. + * all: removed EPL dependency. + * VERSION 0.59 + 2005-07-12 Sean O'Rourke * sepia-w3m.el: fix function name so it's found. diff --git a/Makefile b/Makefile index 6b86f7e..b25dcee 100644 --- a/Makefile +++ b/Makefile @@ -10,10 +10,10 @@ # # MakeMaker Parameters: -# ABSTRACT => q[Simple Emacs-Perl InterAction: ugly, yet effective.] +# ABSTRACT => q[Simple Emacs-Perl InterAction] # AUTHOR => q[Sean O'Rourke ] # NAME => q[Sepia] -# PREREQ_PM => { Emacs::EPL=>q[0], Module::Info=>q[0], Data::Dumper=>q[0] } +# PREREQ_PM => { Module::Info=>q[0], Data::Dumper=>q[0] } # VERSION_FROM => q[Sepia.pm] # --- MakeMaker post_initialize section: @@ -21,31 +21,31 @@ # --- MakeMaker const_config section: -# These definitions are from config.sh (via /usr/local/lib/perl5/5.8.3/darwin-thread-multi/Config.pm) +# These definitions are from config.sh (via /System/Library/Perl/5.8.6/darwin-thread-multi-2level/Config.pm) # They may have been overridden via Makefile.PL or on the command line AR = ar CC = cc -CCCDLFLAGS = -flat_namespace -bundle -fPIC +CCCDLFLAGS = CCDLFLAGS = DLEXT = bundle -DLSRC = dl_dyld.xs -LD = cc -LDDLFLAGS = -flat_namespace -bundle -undefined suppress -L/usr/local/lib -L/opt/local/lib -L/sw/lib -LDFLAGS = -flat_namespace -L/usr/local/lib -L/opt/local/lib -L/sw/lib +DLSRC = dl_dlopen.xs +LD = env MACOSX_DEPLOYMENT_TARGET=10.3 cc +LDDLFLAGS = -bundle -undefined dynamic_lookup -L/usr/local/lib +LDFLAGS = -L/usr/local/lib LIBC = /usr/lib/libc.dylib LIB_EXT = .a OBJ_EXT = .o OSNAME = darwin -OSVERS = 6.8 +OSVERS = 8.0 RANLIB = /usr/bin/ar ts -SITELIBEXP = /usr/local/lib/perl5/site_perl/5.8.3 -SITEARCHEXP = /usr/local/lib/perl5/site_perl/5.8.3/darwin-thread-multi +SITELIBEXP = /Library/Perl/5.8.6 +SITEARCHEXP = /Library/Perl/5.8.6/darwin-thread-multi-2level SO = dylib EXE_EXT = FULL_AR = /usr/bin/ar -VENDORARCHEXP = -VENDORLIBEXP = +VENDORARCHEXP = /Network/Library/Perl/5.8.6/darwin-thread-multi-2level +VENDORLIBEXP = /Network/Library/Perl/5.8.6 # --- MakeMaker constants section: @@ -53,11 +53,11 @@ AR_STATIC_ARGS = cr DIRFILESEP = / NAME = Sepia NAME_SYM = Sepia -VERSION = 0.56 +VERSION = 0.59 VERSION_MACRO = VERSION -VERSION_SYM = 0_56 +VERSION_SYM = 0_59 DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" -XS_VERSION = 0.56 +XS_VERSION = 0.59 XS_VERSION_MACRO = XS_VERSION XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" INST_ARCHLIB = blib/arch @@ -67,55 +67,55 @@ INST_LIB = blib/lib INST_MAN1DIR = blib/man1 INST_MAN3DIR = blib/man3 MAN1EXT = 1 -MAN3EXT = 3 +MAN3EXT = 3pm INSTALLDIRS = site DESTDIR = PREFIX = -PERLPREFIX = /usr/local +PERLPREFIX = / SITEPREFIX = /usr/local -VENDORPREFIX = -INSTALLPRIVLIB = $(PERLPREFIX)/lib/perl5/5.8.3 +VENDORPREFIX = /usr/local +INSTALLPRIVLIB = $(PERLPREFIX)/System/Library/Perl/5.8.6 DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) -INSTALLSITELIB = $(SITEPREFIX)/lib/perl5/site_perl/5.8.3 +INSTALLSITELIB = /Library/Perl/5.8.6 DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) -INSTALLVENDORLIB = +INSTALLVENDORLIB = /Network/Library/Perl/5.8.6 DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) -INSTALLARCHLIB = $(PERLPREFIX)/lib/perl5/5.8.3/darwin-thread-multi +INSTALLARCHLIB = $(PERLPREFIX)/System/Library/Perl/5.8.6/darwin-thread-multi-2level DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) -INSTALLSITEARCH = $(SITEPREFIX)/lib/perl5/site_perl/5.8.3/darwin-thread-multi +INSTALLSITEARCH = /Library/Perl/5.8.6/darwin-thread-multi-2level DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) -INSTALLVENDORARCH = +INSTALLVENDORARCH = /Network/Library/Perl/5.8.6/darwin-thread-multi-2level DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) -INSTALLBIN = $(PERLPREFIX)/bin +INSTALLBIN = $(PERLPREFIX)/usr/bin DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) INSTALLSITEBIN = $(SITEPREFIX)/bin DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) -INSTALLVENDORBIN = +INSTALLVENDORBIN = $(VENDORPREFIX)/bin DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) -INSTALLSCRIPT = $(PERLPREFIX)/bin +INSTALLSCRIPT = $(PERLPREFIX)/usr/bin DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) -INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1 +INSTALLMAN1DIR = $(PERLPREFIX)/usr/share/man/man1 DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) -INSTALLSITEMAN1DIR = $(SITEPREFIX)/share/man/man1 +INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1 DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) -INSTALLVENDORMAN1DIR = +INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/man/man1 DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) -INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3 +INSTALLMAN3DIR = $(PERLPREFIX)/usr/share/man/man3 DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) -INSTALLSITEMAN3DIR = $(SITEPREFIX)/share/man/man3 +INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3 DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) -INSTALLVENDORMAN3DIR = +INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/man/man3 DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) -PERL_LIB = /usr/local/lib/perl5/5.8.3 -PERL_ARCHLIB = /usr/local/lib/perl5/5.8.3/darwin-thread-multi +PERL_LIB = /System/Library/Perl/5.8.6 +PERL_ARCHLIB = /System/Library/Perl/5.8.6/darwin-thread-multi-2level LIBPERL_A = libperl.a FIRST_MAKEFILE = Makefile MAKEFILE_OLD = $(FIRST_MAKEFILE).old MAKE_APERL_FILE = $(FIRST_MAKEFILE).aperl PERLMAINCC = $(CC) -PERL_INC = /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE -PERL = /usr/local/bin/perl -FULLPERL = /usr/local/bin/perl +PERL_INC = /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl ABSPERL = $(PERL) PERLRUN = $(PERL) FULLPERLRUN = $(FULLPERL) @@ -127,7 +127,7 @@ PERL_CORE = 0 PERM_RW = 644 PERM_RWX = 755 -MAKEMAKER = /usr/local/lib/perl5/5.8.3/ExtUtils/MakeMaker.pm +MAKEMAKER = /System/Library/Perl/5.8.6/ExtUtils/MakeMaker.pm MM_VERSION = 6.17 MM_REVISION = 1.133 @@ -174,6 +174,7 @@ PERL_ARCHIVE_AFTER = TO_INST_PM = Sepia.pm \ Xref.pm \ + foo.pl \ modindex.pl \ supers.pl @@ -183,6 +184,8 @@ PM_TO_BLIB = Xref.pm \ $(INST_LIB)/supers.pl \ Sepia.pm \ $(INST_LIB)/Sepia.pm \ + foo.pl \ + $(INST_LIB)/foo.pl \ modindex.pl \ $(INST_LIB)/modindex.pl @@ -247,7 +250,7 @@ RCS_LABEL = rcs -Nv$(VERSION_SYM): -q DIST_CP = best DIST_DEFAULT = tardist DISTNAME = Sepia -DISTVNAME = Sepia-0.56 +DISTVNAME = Sepia-0.59 # --- MakeMaker macro section: @@ -315,21 +318,21 @@ config :: $(INST_ARCHAUTODIR)$(DIRFILESEP).exists config :: $(INST_AUTODIR)$(DIRFILESEP).exists $(NOECHO) $(NOOP) -$(INST_AUTODIR)/.exists :: /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h +$(INST_AUTODIR)/.exists :: /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(NOECHO) $(MKPATH) $(INST_AUTODIR) - $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h $(INST_AUTODIR)/.exists + $(NOECHO) $(EQUALIZE_TIMESTAMP) /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(INST_AUTODIR)/.exists -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_AUTODIR) -$(INST_LIBDIR)/.exists :: /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h +$(INST_LIBDIR)/.exists :: /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(NOECHO) $(MKPATH) $(INST_LIBDIR) - $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h $(INST_LIBDIR)/.exists + $(NOECHO) $(EQUALIZE_TIMESTAMP) /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(INST_LIBDIR)/.exists -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_LIBDIR) -$(INST_ARCHAUTODIR)/.exists :: /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h +$(INST_ARCHAUTODIR)/.exists :: /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) - $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h $(INST_ARCHAUTODIR)/.exists + $(NOECHO) $(EQUALIZE_TIMESTAMP) /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(INST_ARCHAUTODIR)/.exists -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR) @@ -337,9 +340,9 @@ config :: $(INST_MAN3DIR)$(DIRFILESEP).exists $(NOECHO) $(NOOP) -$(INST_MAN3DIR)/.exists :: /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h +$(INST_MAN3DIR)/.exists :: /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(NOECHO) $(MKPATH) $(INST_MAN3DIR) - $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.3/darwin-thread-multi/CORE/perl.h $(INST_MAN3DIR)/.exists + $(NOECHO) $(EQUALIZE_TIMESTAMP) /System/Library/Perl/5.8.6/darwin-thread-multi-2level/CORE/perl.h $(INST_MAN3DIR)/.exists -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_MAN3DIR) @@ -432,7 +435,7 @@ realclean_subdirs : realclean purge :: clean realclean_subdirs $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR) $(RM_RF) $(DISTVNAME) - $(RM_F) $(INST_LIB)/modindex.pl $(INST_LIB)/supers.pl $(MAKEFILE_OLD) $(FIRST_MAKEFILE) $(INST_LIB)/Sepia.pm $(INST_LIB)/Xref.pm + $(RM_F) $(INST_LIB)/modindex.pl $(INST_LIB)/foo.pl $(INST_LIB)/supers.pl $(MAKEFILE_OLD) $(FIRST_MAKEFILE) $(INST_LIB)/Sepia.pm $(INST_LIB)/Xref.pm # --- MakeMaker metafile section: @@ -440,12 +443,11 @@ metafile : $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META.yml $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META.yml $(NOECHO) $(ECHO) 'name: Sepia' >> META.yml - $(NOECHO) $(ECHO) 'version: 0.56' >> META.yml + $(NOECHO) $(ECHO) 'version: 0.59' >> META.yml $(NOECHO) $(ECHO) 'version_from: Sepia.pm' >> META.yml $(NOECHO) $(ECHO) 'installdirs: site' >> META.yml $(NOECHO) $(ECHO) 'requires:' >> META.yml $(NOECHO) $(ECHO) ' Data::Dumper: 0' >> META.yml - $(NOECHO) $(ECHO) ' Emacs::EPL: 0' >> META.yml $(NOECHO) $(ECHO) ' Module::Info: 0' >> META.yml $(NOECHO) $(ECHO) '' >> META.yml $(NOECHO) $(ECHO) 'distribution_type: module' >> META.yml @@ -671,7 +673,7 @@ $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) # --- MakeMaker makeaperl section --- MAP_TARGET = perl -FULLPERL = /usr/local/bin/perl +FULLPERL = /usr/bin/perl $(MAP_TARGET) :: static $(MAKE_APERL_FILE) $(MAKE) -f $(MAKE_APERL_FILE) $@ @@ -711,16 +713,15 @@ testdb_static :: testdb_dynamic # --- MakeMaker ppd section: # Creates a PPD (Perl Package Description) for a binary distribution. ppd: - $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' Simple Emacs-Perl InterAction: ugly, yet effective.' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' Simple Emacs-Perl InterAction' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' Sean O'\''Rourke <seano@cpan.org>' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd @@ -733,6 +734,7 @@ pm_to_blib: $(TO_INST_PM) Xref.pm $(INST_LIB)/Xref.pm \ supers.pl $(INST_LIB)/supers.pl \ Sepia.pm $(INST_LIB)/Sepia.pm \ + foo.pl $(INST_LIB)/foo.pl \ modindex.pl $(INST_LIB)/modindex.pl $(NOECHO) $(TOUCH) $@ diff --git a/Makefile.PL b/Makefile.PL index c15b2f4..66fbad7 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -5,7 +5,7 @@ WriteMakefile( 'NAME' => 'Sepia', 'VERSION_FROM' => 'Sepia.pm', # finds $VERSION 'PREREQ_PM' => { 'Data::Dumper' => 0, - 'Module::Info' => 0 }, + 'B::Module::Info' => 0 }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (AUTHOR => "Sean O'Rourke ", ABSTRACT => 'Simple Emacs-Perl InterAction') diff --git a/README b/README index 5c848ed..76bf3a5 100644 --- a/README +++ b/README @@ -6,8 +6,7 @@ development, including: * an interactive prompt (REPL) for evaluating code; * cross-referencing to find and navigate between function and variable definitions and uses; - * variable- and function-name completion based on this Xref - database. + * variable- and function-name completion. * eldoc support to echo function arguments in the minibuffer * functions to simplify POD browsing with Emacs-w3m @@ -43,15 +42,15 @@ outdated when the program changes, it must be built explicitly by M-x sepia-rebuild RET -In a Perl buffer with Sepia enabled, type +Type C-h f sepia-init RET -to get a list of functions using it. In general, the functions will -look up zero or more source locations, then allow you to cycle -through them with "M-x sepia-next". With a prefix argument, the -functions will instead display a grep-mode buffer listing all the -hits, from which you can then navigate. +to get a list of Sepia functions. The xref functions will look up +zero or more source locations, then allow you to cycle through them +with "M-x sepia-next". With a prefix argument, the functions will +instead display a grep-mode buffer listing all the hits, from which +you can then navigate. * TODO @@ -65,9 +64,6 @@ hits, from which you can then navigate. * BUGS -.- Emacs may display a "not enough arguments for format string" error. - This is probably caused by some code passing using (message STR) - instead of (message "%s" STR), but I haven't tracked it down yet. .- Function definition lines may occasionally all go completely wrong. Rebuilding the Xref database fixes this. .- The cursor may miss by several lines when jumping to a definition. @@ -83,6 +79,5 @@ hits, from which you can then navigate. Sepia would never have been possible without Software Libre, as many key components have been stolen and adapted from other packages: - * generic-repl is taken from Slime; - * Devel::Xref is taken from B::Xref; - * sepia-w3m is taken from w3m-perldoc; + * Sepia::Xref is taken from B::Xref. + * sepia-w3m is taken from w3m-perldoc. diff --git a/Sepia.pm b/Sepia.pm index 67b41d4..ef8bc6a 100644 --- a/Sepia.pm +++ b/Sepia.pm @@ -1,5 +1,5 @@ package Sepia; -our $VERSION = '0.59'; +our $VERSION = '0.60'; require Exporter; our @ISA = qw(Exporter); @@ -10,59 +10,78 @@ use Scalar::Util 'looks_like_number'; use Module::Info; use B; +=item C<@compls = completions($string [, $type])> + +Find a list of completions for C<$string> with glob type $type. +Completion operates on word subparts separated by [:_], so +e.g. "S:m_w" completes to "Sepia::my_walksymtable". + +=cut + + sub _apropos_re($) { # Do that crazy multi-word identifier completion thing: my $re = shift; - if ($re !~ /[^\w\d_^:]/) { - $re =~ s/(?<=[A-Za-z\d])(([^A-Za-z\d])\2*)/[A-Za-z\\d]*$1+/g; + if (wantarray) { + map { + s/(?:^|(?<=[A-Za-z\d]))(([^A-Za-z\d])\2*)/[A-Za-z\\d]*$2+/g; + qr/^$_/ + } split /:+/, $re, -1; + } else { + if ($re !~ /[^\w\d_^:]/) { + $re =~ s/(?<=[A-Za-z\d])(([^A-Za-z\d])\2*)/[A-Za-z\\d]*$2+/g; + } + qr/$re/; } - qr/$re/; } -=item C<@compls = completions($string [, $package])> +sub _completions1 +{ + no strict; + my $stash = shift; + if (@_ == 1) { + map { + "$stash$_" + } grep /$_[0]/, keys %$stash; + } else { + my $re = shift; + map { + _completions1("$stash$_", @_); + } grep /$re.*::$/, keys %$stash; + }; +} -Find a list of completions for C<$string>; if C<$string> has no -package prefixes, C<$package> may specify a package in which to look. -Completion operates on word subparts separated by [:_], so -e.g. "S:m_w" completes to "Sepia::my_walksymtable". +sub _completions +{ + _completions1 '::', _apropos_re($_[0]); +} -=cut +my %sigil; +BEGIN { + %sigil = qw(ARRAY @ SCALAR $ HASH %); +} sub completions { no strict; - my ($str, $pack) = @_; - if (my ($pfx, $name) = $str =~ /^([\%\$\@]?)(.+)/) { - my @nameparts = split /:+/, $name, 1000; - if (@nameparts == 1 && $pack) { - @nameparts = (split(/:+/, $pack), $name); - } - local *_completions = sub { - no strict; - my ($stash, $part, @rest) = @_; - $part = join '[^_]*_', split /_/, $part, 1000; - $part = _apropos_re($part); - if (@rest) { - map { - _completions("$stash$_", @rest) - } grep /^$part.*\::$/, keys %$stash; - } else { - map { "$stash$_" } grep /^$part/, keys %$stash; - } - }; - - my $type = ($pfx eq '$' ? 'SCALAR' - : $pfx eq '@' ? 'ARRAY' - : $pfx eq '&' ? 'CODE' - : $pfx eq '%' ? 'HASH' - : undef); - map { - s/^(?::*main)?::/$pfx/;$_ - } grep { - !$type || defined(*{$_}{$type}) - } _completions('::', @nameparts); - } + my ($str, $type, $infunc) = @_; + map { s/^:://; $_ } ($type ? do { + (grep { defined *{$_}{$type} } _completions $str), + (defined $infunc && defined *{$infunc}{CODE}) ? do { + my ($apre) = _apropos_re($str); + my $st = $sigil{$type}; + grep { + (my $tmp = $_) =~ s/^\Q$st//; + $tmp =~ /$apre/; + } lexicals($infunc); + } : (); + } : do { + grep { + defined *{$_}{CODE} || defined *{$_}{IO} + || (/::$/ && defined *{$_}{HASH}); + } _completions $str; + }) } =item C<@locs = location(@names)> @@ -75,7 +94,7 @@ name in C<@names>. sub location { no strict; - map { + my @x= map { my $str = $_; if (my ($pfx, $name) = $str =~ /^([\%\$\@]?)(.+)/) { if ($pfx) { @@ -100,15 +119,15 @@ sub location my ($shortname) = $name =~ /^(?:.*::)([^:]+)$/; [Cwd::abs_path($file), $line, $shortname || $name] } else { -# print STDERR "Bad CV for $name: $cv"; + print STDERR "Bad CV for $name: $cv"; []; } } } else { -# print STDERR "Name `$str' doesn't match."; [] } - } @_ + } @_; + return @x; } =item C<@matches = apropos($name [, $is_regex])> @@ -161,7 +180,6 @@ sub apropos } else { my @ret; my $findre = $re ? qr/$it/ : qr/^\Q$it\E$/; -# print STDERR "Searching for $findre..."; my_walksymtable { push @ret, "$stash$_" if /$findre/; } '::'; @@ -265,41 +283,6 @@ sub lexicals } grep B::class($_) ne 'SPECIAL', $names->ARRAY; } -###################################################################### -## XXX: this is the only part that depends on Emacs: - -# { package EL; -# use Emacs::Lisp; -# ## XXX: "submit a patch" to use (message ...) correctly -- message's -# ## first argument is actually a format, not a plain string. -# sub Emacs::Minibuffer::WRITE { -# my ($stream, $output, $length, $offset) = @_; -# Emacs::Lisp::message ('%s', substr ($output, $offset, $length)); -# return ($length); -# } -# } - -=item C<$func = emacs_warner($bufname)> - -Create a function that will insert its arguments into Emacs buffer -C<$bufname>. Useful as a C<$SIG{__WARN__}> handler. - -=cut - -sub emacs_warner -{ - shift; warn "@_"; -# my $buf = shift; -# $buf = EL::get_buffer_create($buf); -# return sub { -# my $msg = "@_"; # can't be inside EL::save_current_buffer -# EL::save_current_buffer { -# EL::set_buffer($buf); -# EL::insert($msg); -# }; -# }; -} - =item C<$lisp = tolisp($perl)> Convert a Perl scalar to some ELisp equivalent. @@ -308,7 +291,7 @@ Convert a Perl scalar to some ELisp equivalent. sub tolisp($) { - my $thing = shift; + my $thing = @_ == 1 ? shift : \@_; my $t = ref $thing; if (!$t) { if (looks_like_number $thing) { @@ -337,7 +320,12 @@ sub printer { no strict; local *res = shift; - print "=> @res\n"; + my $marker = shift; + if ($marker) { + print "\n$marker\n@res\n$marker\n"; + } else { + print "=> @res\n"; + } } =item C @@ -354,12 +342,18 @@ sub repl print $ps1; repl: while (my $in = <$fh>) { $buf .= $in; + my $marker; if ($buf =~ /^eval\s+<<(REPL\S*)\s*$/) { + $marker = $1; $buf = ''; local $/ = "\n$1\n"; - $buf = <$fh>; + chomp($buf = <$fh>); } local $SIG{INT} = sub { $buf = ""; next repl }; + my @warn; + local $SIG{__WARN__} = sub { + push @warn, shift; + }; my @res; { no strict; @@ -377,11 +371,13 @@ sub repl } else { warn $@; $buf = ''; + Sepia::printer \@res, $marker if $marker; } } else { - Sepia::printer \@res unless $buf =~ /;$/; + Sepia::printer \@res, $marker unless $buf =~ /;$/; $buf = ''; } + print "@warn\n" if @warn; print $ps1; } } diff --git a/Xref.pm b/Xref.pm index a1860e1..67dc5a7 100644 --- a/Xref.pm +++ b/Xref.pm @@ -1,8 +1,6 @@ ###################################################################### package Sepia::Xref; -our $VERSION = '0.58'; - =head1 NAME Sepia::Xref - Generates cross reference database for use by Perl programs. @@ -42,6 +40,8 @@ use B qw(peekop class comppadlist main_start svref_2object walksymtable require Sepia; BEGIN { *_apropos_re = *Sepia::_apropos_re; } +BEGIN { no strict; *VERSION = *Sepia::VERSION; } + =head2 Variables =over @@ -668,9 +668,9 @@ sub var_assigns { =item C List the modules defined in file C<$file>. - + =cut - + sub file_modules { my $file = shift; eval "use Module::Include;" and do { diff --git a/package.sh b/package.sh index 63275fd..83792d5 100755 --- a/package.sh +++ b/package.sh @@ -1,3 +1,4 @@ files=$(perl -e 'chomp(@x=<>);print join ",",@x' MANIFEST) +ver=$(perl -MSepia -e 'print $Sepia::VERSION') cd .. -eval "tar czvf sepia-$1.tgz sepia/{$files}" +eval "tar czvf sepia-$ver.tgz sepia/{$files}" diff --git a/sepia-ido.el b/sepia-ido.el index 8ff761b..71eb989 100644 --- a/sepia-ido.el +++ b/sepia-ido.el @@ -122,12 +122,10 @@ bells-and-whistles. Arguments are: (ido-set-matches) ;; Enter something ending in a "slash" - (when (and ido-enter-single-matching-directory - ido-matches + (when (and ido-matches (null (cdr ido-matches)) (ido-final-slash (car ido-matches)) - (or try-single-dir-match - (eq ido-enter-single-matching-directory t))) + try-single-dir-match) (ido-set-current-directory (concat ido-current-directory (car ido-matches))) (setq ido-exit 'refresh) diff --git a/sepia.el b/sepia.el index ebc6a5d..4707add 100644 --- a/sepia.el +++ b/sepia.el @@ -44,7 +44,7 @@ (concat "tolisp([" str "])")) (scalar-context (concat "tolisp(scalar(" str "))")) - (t (concat str ";1;\n")))))) + (t (concat str ";1")))))) (when res (car (read-from-string res))))) @@ -207,12 +207,19 @@ Does not require loading.") (apply #'define-xref-function "Sepia::Xref" x))) (add-hook 'cperl-mode-hook 'sepia-install-eldoc) (add-hook 'cperl-mode-hook 'sepia-doc-update) + (add-hook 'cperl-mode-hook 'sepia-cperl-mode-hook) (when (boundp 'cperl-mode-map) (sepia-install-keys cperl-mode-map)) (when (boundp 'perl-mode-map) (sepia-install-keys perl-mode-map)) (sepia-interact)) +(defun sepia-cperl-mode-hook () + (set (make-local-variable 'beginning-of-defun-function) + 'sepia-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + 'sepia-end-of-defun)) + (defun define-xref-function (package name doc) "Define a lisp mirror for a low-level Sepia function." (let ((lisp-name (intern (format "xref-%s" name))) @@ -243,22 +250,48 @@ module in question be loaded."))) (let ((th (thing-at-point what))) (and th (not (string-match "[ >]$" th)) th))) -(defun sepia-beginning-of-defun (where) +(defvar sepia-sub-re "^\\s *sub\\s +\\(.+\\_>\\)") + +(defun sepia-beginning-of-defun (&optional where) + (interactive "d") + (let ((here (point))) + (beginning-of-line) + (if (and (not (= here (point))) + (looking-at sepia-sub-re)) + (point) + (beginning-of-defun) + (let* ((end (point)) + (beg (progn (previous-line 3) (point)))) + (goto-char end) + (re-search-backward sepia-sub-re beg t))))) + +(defun sepia-end-of-defun (&optional where) (interactive "d") - (beginning-of-defun) - (let* ((end (point)) - (beg (progn (previous-line 3) (point)))) - (goto-char end) - (re-search-backward "^\\s *sub\\s +\\(.+\\_>\\)" beg t))) + (let ((here (point))) + (beginning-of-defun) + (let ((beg (point)) + (end-of-defun-function nil) + (beginning-of-defun-function nil)) + (when (looking-at sepia-sub-re) + (forward-line 1)) + (end-of-defun)) + (when (and (>= here (point)) + (re-search-forward sepia-sub-re nil t)) + (sepia-end-of-defun)) + (point))) -(defun sepia-defun-around-point (where) +(defun sepia-defun-around-point (&optional where) (interactive "d") + (unless where + (setq where (point))) (save-excursion (and (sepia-beginning-of-defun where) (match-string-no-properties 1)))) -(defun sepia-lexicals-at-point (where) +(defun sepia-lexicals-at-point (&optional where) (interactive "d") + (unless where + (setq where (point))) (let ((subname (sepia-defun-around-point where)) (mod (sepia-buffer-package))) (xref-lexicals (perl-name subname mod)))) @@ -413,12 +446,13 @@ buffer. * Prompt otherwise " (interactive "P") - (multiple-value-bind (obj mod type raw) (sepia-ident-at-point) - (message "%S" (list obj mod type raw)) + (multiple-value-bind (type obj) (sepia-ident-at-point) + (setq type (if type (string type) "")) + (message "%s %S" type obj) (if type (progn - (sepia-set-found nil type) - (let ((ret (ecase type +;; (sepia-set-found nil 'variable) + (let ((ret (if type (function (list (sepia-location raw))) (variable (xref-var-uses raw)) (module `((,(car (xref-mod-files mod)) 1 nil nil)))))) @@ -493,15 +527,18 @@ called interactively), also rebuild the xref database." (interactive (progn (save-buffer) (list (buffer-file-name) prefix-arg - (format "*%s errors*" (buffer-file-name))))) + ;; (format "*%s errors*" (buffer-file-name)) + nil + ))) (message "sepia: %s returned %s" (abbreviate-file-name file) (perl-eval - (if collect-warnings - (format "{ local $SIG{__WARN__} = Sepia::emacs_warner('%s'); do '%s' }" - collect-warnings file) - (format "do '%s';" file)))) +;; (if collect-warnings +;; (format "{ local $SIG{__WARN__} = Sepia::emacs_warner('%s'); do '%s' }" +;; collect-warnings file) + (format "do '%s' ? 1 : $@" file) + 'scalar-context)) (when collect-warnings (with-current-buffer (get-buffer-create collect-warnings) (sepia-display-errors (point-min) (point-max)) @@ -588,56 +625,40 @@ called interactively), also rebuild the xref database." ;; Completion (defun sepia-ident-at-point () - "Find the perl identifier at point, returning -\(values OBJECT MODULE TYPE RAW), where TYPE is either 'variable, -'function, or 'module. If TYPE is 'module, OBJ is the last -component of the module name." - (let ((cperl-under-as-char nil) - (case-fold-search nil) - var-p module-p modpart objpart) - (save-excursion - (condition-case c - (destructuring-bind (sbeg . send) (bounds-of-thing-at-point 'symbol) - (goto-char send) - (destructuring-bind (wbeg . wend) - (or (bounds-of-thing-at-point 'word) (cons (point) (point))) - (if (member (char-before send) '(?> ?\ )) - (signal 'wrong-number-of-arguments 'sorta)) - (setq var-p - (or (and (member (char-before wbeg) '(?@ ?$ ?%)) - (char-before wbeg)) - (and (member (char-before sbeg) '(?@ ?$ ?%)) - (char-before sbeg)))) - (setq module-p - (save-excursion - (goto-char send) - (backward-word) - (looking-at "[A-Z]"))) - (setq modpart - (if (= sbeg wbeg) - nil - (buffer-substring sbeg - (if (= (char-before (1- wbeg)) ?\:) - (- wbeg 2) - (1- wbeg))))) - (setq objpart (buffer-substring wbeg wend)) - (values (if module-p - (list objpart modpart (if var-p 'variable 'function)) - objpart) - (if module-p - (buffer-substring sbeg send) - modpart) - (cond - (module-p 'module) - (var-p 'variable) - (t 'function)) - (concat (if var-p (char-to-string var-p) "") - (buffer-substring sbeg send))))) - (wrong-number-of-arguments (values nil nil nil)))))) - -;; (defun delete-ident-at-point () -;; (destructuring-bind (beg . end) (bounds-of-thing-at-point sym) -;; (delete-region beg end))) + (save-excursion + (when (looking-at "[%$@*&]") + (forward-char 1)) + (let* ((beg (progn + (when (re-search-backward "[^A-Za-z_0-9:]" nil 'mu) + (forward-char 1)) + (point))) + (sigil (if (= beg (point-min)) + nil + (char-before (point)))) + (end (progn + (when (re-search-forward "[^A-Za-z_0-9:]" nil 'mu) + (forward-char -1)) + (point)))) + (list (when (member sigil '(?$ ?@ ?% ?* ?&)) sigil) + (buffer-substring-no-properties beg end))))) + +(defun sepia-function-at-point () + (condition-case nil + (save-excursion + (let ((pt (point)) + bof) + (sepia-beginning-of-defun) + (setq bof (point)) + (goto-char pt) + (sepia-end-of-defun) + (when (and (>= pt bof) (< pt (point))) + (goto-char bof) + (looking-at "\\s *sub\\s +") + (forward-char (length (match-string 0))) + (concat (or (sepia-buffer-package) "") + "::" + (cadr (sepia-ident-at-point)))))) + (error nil))) (defun sepia-complete-symbol () "Try to complete the word at point, either as a global variable if it @@ -648,29 +669,35 @@ annoying in larger programs. The function is intended to be bound to \\M-TAB, like ``lisp-complete-symbol''." (interactive) - (multiple-value-bind (name mod type raw-name) (sepia-ident-at-point) - (let ((tap (or raw-name - (and (eq last-command 'sepia-complete-symbol) "")))) - (when tap - (let ((completions (xref-completions tap (sepia-buffer-package)))) - (case (length completions) - (0 (message "No completions for %s." tap) nil) - (1 ;; (delete-ident-at-point) - (delete-region (- (point) (length tap)) (point)) - (insert (car completions)) - t) - (t (let ((old tap) - (new (try-completion "" completions))) - (if (string= new old) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list completions)) -;; (delete-region ...) -;; (delete-ident-at-point) - (delete-region (- (point) (length tap)) (point)) - (insert new))) - t))) -;; (message "sepia: empty -- hit tab again to complete.") - )))) + (multiple-value-bind (type name) (sepia-ident-at-point) + (let ((len (+ (if type 1 0) (length name))) + (completions (xref-completions + (if (string-match ":" name) + name + (concat (sepia-buffer-package) "::" name)) + (case type + (?$ "SCALAR") + (?@ "ARRAY") + (?% "HASH") + (?& "CODE") + (?* "IO") + (t "")) + (sepia-function-at-point)))) + (case (length completions) + (0 (message "No completions for %s." name) nil) + (1 ;; (delete-ident-at-point) + (delete-region (- (point) len) (point)) + (insert (if type (string type) "") (car completions)) + t) + (t (let ((old name) + (new (try-completion "" completions))) + (if (string= new old) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list completions)) + (delete-region (- (point) len) (point)) + (insert (if type (string type) "") new))) + t))) + )) (defun sepia-indent-or-complete () "Indent the current line and, if indentation doesn't move point, @@ -875,6 +902,7 @@ the only function that requires EPL (the rest can use Pmacs)." (defun sepia-doc-scan-buffer () (save-excursion + (ignore-errors (goto-char (point-min)) (loop while (re-search-forward "^=\\(item\\|head2\\)\\s +\\([%$&@A-Za-z_].*\\)" nil t) @@ -902,7 +930,7 @@ the only function that requires EPL (the rest can use Pmacs)." ;; e.g. "$x -- this is x" (note: this has to come second) ((string-match "^[%$@]\\([^( ]+\\)" s2) (list 'variable (match-string-no-properties 1 s2) longdoc)))) - collect it))) + collect it)))) (defun sepia-buffer-package () (save-excursion -- 2.11.4.GIT