[sepia] 12/63: Imported Debian patch 0.76-1
Hilko Bengen
bengen at moszumanska.debian.org
Sat Aug 8 11:20:33 UTC 2015
This is an automated email from the git hooks/post-receive script.
bengen pushed a commit to branch master
in repository sepia.
commit 010a00e77bab0e717161864016d870edbc84d7ec
Author: Hilko Bengen <bengen at debian.org>
Date: Wed May 30 16:09:38 2007 +0200
Imported Debian patch 0.76-1
---
ChangeLog | 47 +++++--
META.yml | 2 +-
Makefile.PL | 24 ++--
README | 5 +-
debian/NOTES | 12 ++
debian/changelog | 8 ++
debian/control | 7 +-
debian/emacsen-install | 1 +
debian/emacsen-remove | 1 +
debian/emacsen-startup | 4 +-
debian/rules | 9 +-
lib/Sepia.pm | 154 +++++++++++++++++------
lib/Sepia/Xref.pm | 4 +-
sepia-w3m.el | 8 --
sepia.el | 323 +++++++++++++++++++++++++++++++++++++------------
test.pl | 41 ++++---
16 files changed, 472 insertions(+), 178 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 37b8a29..27c1ba0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,29 +1,63 @@
+2007-05-29 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * lib/sepia/Xref.pm (pp_method_named): warn -> dprint.
+ * sepia.el (sepia-simple-method-before-point): new function.
+ (sepia-complete-symbol): use it to complete methods.
+ make w3m optional:
+ (sepia-perldoc-function,sepia-view-pod-function,
+ sepia-module-list-function): new variables.
+ (sepia-perldoc-this,sepia-view-pod): new functions.
+ * lib/Sepia.pm (repl): trim leading spaces.
+ (tolisp): escape metacharacters.
+ (repl): don't override "die" if someone has installed a
+ $SIG{__DIE__} handler
+
+2007-05-28 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * VERSION: 0.75+
+ * sepia.el (sepia-core-version): new function.
+ (sepia-indent-or-complete): fix abbrev expansion.
+ (sepia-symbol-info): report core version in eldoc.
+ (sepia-ident-before-point): new function.
+ (sepia-complete-symbol): use it instead of *-at-point.
+ (sepia-complete-symbol): complete arrays and hashes when '$'
+ starts a word.
+ * lib/Sepia.pm (printer): Use @::__; distinguish "last as scalar"
+ $__ from printed representation.
+ ($PRINT_PRETTY): columnate lists if this is on.
+ (columnate): fixed.
+ (repl_methods): add regex argument.
+ (repl_who): fix.
+ (completions): Add in package names.
+
+2007-05-27 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * lib/Sepia.pm (repl_methods): fixed.
+
2007-05-26 Sean O'Rourke <sorourke at cs.ucsd.edu>
* VERSION: 0.74
* sepia.el (sepia-doc-scan-buffer): Better doc regex for
variables.
(sepia-indent-or-complete): try to expand abbrevs before
- completion (try with snippet.el).
+ completion (try with snippet.el).
(sepia-indent-expand-abbrev): control the above feature.
(sepia-complete-symbol): scroll completion buffer; suggested by
- Hilko Bengen.
-
+ Hilko Bengen.
* lib/Sepia.pm (html_package_list,html_module_list): new
functions.
(completions): '$'-completion only generates scalars.
-
* sepia-w3m.el: remove spurious sepia-module-list, improve
documentation.
(sepia-module-list,sepia-package-list): better output.
(sepia-package-list,sepia-module-list): move Perl code to
- Sepia.pm, generate list in inferior perl instead of shelling out.
+ Sepia.pm, generate list in inferior perl instead of shelling
+ out.
2007-05-23 Sean O'Rourke <sorourke at cs.ucsd.edu>
* lib/Sepia.pm (_apropos_re): handle empty completions.
(columnate): pretty-print ",who" output.
-
* sepia.el (sepia-complete-symbol): bury stale completions buffer;
suggested by Hilko Bengen.
@@ -36,7 +70,6 @@
* sepia.el (sepia-dwim): don't try to jump to location when
looking up module docs.
-
* lib/Sepia.pm: use $::__ instead of $Sepia::__
(repl_quit): new command.
(repl): add banner.
diff --git a/META.yml b/META.yml
index ef8e150..34bf991 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Sepia
-version: 0.74
+version: 0.76
abstract: Simple Emacs-Perl InterAction
license: perl
generated_by: ExtUtils::MakeMaker version 6.31
diff --git a/Makefile.PL b/Makefile.PL
index fc8f4fa..570e785 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -22,18 +22,16 @@ to move the Emacs Lisp files somewhere. Where will depend on your
installation.
EOS
-eval { require PadWalker };
-if ($@) {
- print <<EOS;
-
-Stack/lexical inspection requires PadWalker >= 1.0.
-EOS
+sub test_for
+{
+ my $mod = shift;
+ eval "require $mod";
+ if ($@) {
+ print "@_\n";
+ }
}
-eval { require Lexical::Persistence };
-if ($@) {
- print <<EOS;
-
-Strict mode requires Lexical::Persistence.
-EOS
-}
+test_for 'PadWalker', 'Stack/lexical inspection requires PadWalker >= 1.0.';
+test_for 'Lexical::Persistence', 'Strict mode requires Lexical::Persistence.';
+test_for 'Module::CoreList',
+ 'sepia-core-version requires Module::CoreList.';
diff --git a/README b/README
index 84a9ed4..d23ad5f 100644
--- a/README
+++ b/README
@@ -191,10 +191,10 @@ Install Sepia bindings in the current local keymap.
Find all subroutines in a package.
** Documentation browsing
-*** (`sepia-w3m-perldoc-this')
+*** (`sepia-perldoc-this')
View perldoc for module at point.
-*** (`sepia-w3m-view-pod')
+*** (`sepia-view-pod')
View POD for the current buffer.
*** (`sepia-package-list')
@@ -241,7 +241,6 @@ some operations, if you don't mind losing completion.
** (Medium) Support user-defined abbrevs in REPL
** (Easy) Clean up Perl side a bit more.
** (Hard) Use module, file, line to filter results (Emacs side)
-
* BUGS
** Function definition lines may occasionally all go completely wrong.
Rebuilding the Xref database fixes this.
diff --git a/debian/NOTES b/debian/NOTES
new file mode 100644
index 0000000..07f3b42
--- /dev/null
+++ b/debian/NOTES
@@ -0,0 +1,12 @@
+-*- org -*-
+* Dependencies:
+ tree-eidget.el (included in .deb)
+ ido.el: emacs-goodies, included in emacs22
+ mule-ucs:
+ semi
+ flim
+ apel
+
+ semi | emacs-snapshot,
+ flim | emacs-snapshot,
+ apel | emacs-snapshot,
diff --git a/debian/changelog b/debian/changelog
index 8af9ac8..fb98eca 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,11 @@
+sepia (0.76-1) unstable; urgency=low
+
+ * New upstream release
+ * Made requirement on w3m-perldoc error-tolerant
+ * Added emacs22 dependencies
+
+ -- Hilko Bengen <bengen at debian.org> Wed, 30 May 2007 16:09:38 +0200
+
sepia (0.74-2) unstable; urgency=low
* Added w3m-el to dependencies
diff --git a/debian/control b/debian/control
index a658455..c5dfcc1 100644
--- a/debian/control
+++ b/debian/control
@@ -11,11 +11,8 @@ Architecture: all
Depends: ${perl:Depends},
libpadwalker-perl (>= 1.0), libmodule-info-perl, libsub-uplevel-perl,
emacs21 | emacs-snapshot,
- emacs-goodies-el | emacs-snapshot,
- semi | emacs-snapshot,
- flim | emacs-snapshot,
- apel | emacs-snapshot,
- w3m-el
+ emacs-goodies-el | emacs-snapshot
+Recommends: w3m-el, perl-doc
Description: Simple Emacs-Perl InterAction
Sepia is a set of features to make Emacs a better tool for Perl
development, including:
diff --git a/debian/emacsen-install b/debian/emacsen-install
index fa4f9ce..8a3a6aa 100644
--- a/debian/emacsen-install
+++ b/debian/emacsen-install
@@ -9,6 +9,7 @@ FLAVOR=$1
PACKAGE=sepia
case ${FLAVOR} in
+ emacs22);;
emacs21);;
emacs-snapshot);;
*) exit 0;;
diff --git a/debian/emacsen-remove b/debian/emacsen-remove
index 0529381..78fcafb 100644
--- a/debian/emacsen-remove
+++ b/debian/emacsen-remove
@@ -5,6 +5,7 @@ FLAVOR=$1
PACKAGE=sepia
case ${FLAVOR} in
+ emacs22);;
emacs21);;
emacs-snapshot);;
*) exit 0;;
diff --git a/debian/emacsen-startup b/debian/emacsen-startup
index 8753643..7091088 100644
--- a/debian/emacsen-startup
+++ b/debian/emacsen-startup
@@ -7,5 +7,5 @@
;; removed but not purged, and we should skip the setup.
(when (file-directory-p package-dir)
(setq load-path (cons package-dir load-path))
- (autoload 'sepia-init "sepia"
- "Perform the initialization necessary to start Sepia." t )))
+ (autoload 'sepia-repl "sepia"
+ "Start the Sepia REPL." t )))
diff --git a/debian/rules b/debian/rules
index bb94115..87cee0d 100755
--- a/debian/rules
+++ b/debian/rules
@@ -27,6 +27,8 @@ build-stamp:
$(PERL) Makefile.PL INSTALLDIRS=vendor
$(MAKE) OPTIMIZE="-Wall -O2 -g"
+ makeinfo sepia.texi
+
touch build-stamp
clean:
@@ -35,6 +37,7 @@ clean:
# Add commands to clean up after the build process here
[ ! -f Makefile ] || $(MAKE) realclean
+ rm -f sepia.info
dh_clean build-stamp install-stamp
@@ -64,17 +67,15 @@ binary-arch:
binary-indep: build install
dh_testdir
dh_testroot
-# dh_installcron
-# dh_installmenu
-# dh_installexamples
dh_installdocs README
dh_installchangelogs ChangeLog
dh_installemacsen
- dh_perl
+ dh_installinfo sepia.info
dh_link
dh_strip
dh_compress
dh_fixperms
+ dh_perl
dh_installdeb
dh_gencontrol
dh_md5sums
diff --git a/lib/Sepia.pm b/lib/Sepia.pm
index 1bd3eb5..94eaef3 100644
--- a/lib/Sepia.pm
+++ b/lib/Sepia.pm
@@ -17,7 +17,7 @@ At the prompt in the C<*perl-interaction*> buffer:
=cut
-$VERSION = '0.74';
+$VERSION = '0.76';
@ISA = qw(Exporter);
require Exporter;
@@ -30,7 +30,7 @@ use Carp;
use B;
use vars qw($PS1 $dies $STOPDIE $STOPWARN %REPL %RK %REPL_DOC
- $PACKAGE $WANTARRAY $PRINTER $STRICT);
+ $PACKAGE $WANTARRAY $PRINTER $STRICT $PRINT_PRETTY);
BEGIN {
eval { require PadWalker; import PadWalker qw(peek_my) };
@@ -54,6 +54,12 @@ BEGIN {
0;
};
}
+ eval { require Module::CoreList };
+ if ($@) {
+ *core_version = sub { '???' };
+ } else {
+ *core_version = sub { Module::CoreList->first_release(@_) };
+ }
}
=head1 DESCRIPTION
@@ -69,10 +75,21 @@ interface.
=head2 C<@compls = completions($string [, $type])>
-Find a list of completions for C<$string> with glob type $type.
+Find a list of completions for C<$string> with glob type C<$type>,
+which may be "SCALAR", "HASH", "ARRAY", "CODE", "IO", or the special
+value "VARIABLE", which means either scalar, hash, or array.
Completion operates on word subparts separated by [:_], so
e.g. "S:m_w" completes to "Sepia::my_walksymtable".
+=head2 C<@compls = method_completions($expr, $string [,$eval])>
+
+Complete among methods on the object returned by C<$expr>. The
+C<$eval> argument, if present, is a function used to do the
+evaluation; the default is C<eval>, but for example the Sepia REPL
+uses C<Sepia::repl_eval>. B<Warning>: Since it has to evaluate
+C<$expr>, method completion can be extremely problematic. Use with
+care.
+
=cut
sub _apropos_re($)
@@ -131,7 +148,13 @@ sub completions
} _completions $str;
} else {
@ret = grep {
- $type eq 'SCALAR' ? defined ${$_} : defined *{$_}{$type}
+ if ($type eq 'SCALAR') {
+ defined ${$_};
+ } elsif ($type eq 'VARIABLE') {
+ defined ${$_} || defined *{$_}{HASH} || defined *{$_}{ARRAY};
+ } else {
+ defined *{$_}{$type}
+ }
} _completions $str;
if (defined $infunc && defined *{$infunc}{CODE}) {
my ($apre) = _apropos_re($str);
@@ -166,13 +189,41 @@ sub completions
} lexicals($infunc);
}
}
+ ## Complete packages so e.g. "new B:T" -> "new Blah::Thing"
+ ## instead of "new Blah::Thing::"
+ if (!$type) {
+ @ret = map { /(.*)::$/ ? ($1, $_) : $_ } @ret;
+ }
## XXX: Control characters, $", and $1, etc. confuse Emacs, so
## remove them.
grep {
- !looks_like_number $_ && !/^[^\w\d_]$/ && !/^_</ && !/^[[:cntrl:]]/
+ length > 0 && !looks_like_number $_ && !/^[^\w\d_]$/ && !/^_</ && !/^[[:cntrl:]]/
} map { s/^:://; $_ } @ret;
}
+sub method_completions
+{
+ my ($expr, $fn, $eval) = @_;
+ $expr =~ s/^\s+//;
+ $expr =~ s/\s+$//;
+ $eval ||= 'eval';
+ no strict;
+ my $x;
+ if ($x =~ /^\$/) {
+ $x = $eval->("ref($expr)");
+ } elsif ($eval->('defined(%{'.$expr.'::})')) {
+ $x = $expr;
+ } else {
+ return;
+ }
+ unless ($@) {
+ my $re = _apropos_re $fn;
+ print STDERR "$x / $re\n";
+ return sort { $a cmp $b } map { s/.*:://; $_ }
+ grep { defined *{$_}{CODE} && /::$re/ } methods($x, 1);
+ }
+}
+
=head2 C<@locs = location(@names)>
Return a list of [file, line, name] triples, one for each function
@@ -450,7 +501,9 @@ sub tolisp($)
} elsif (looks_like_number $thing) {
''.(0+$thing);
} else {
- qq{"$thing"};
+ ## XXX Elisp and perl probably have slightly different
+ ## escaping conventions, but oh well...
+ '"'.quotemeta($thing).'"';
}
} elsif ($t eq 'GLOB') {
(my $name = $$thing) =~ s/\*main:://;
@@ -493,7 +546,7 @@ sub print_dumper
sub print_plain
{
no strict;
- $::__ = "@res";
+ "@res";
}
sub print_yaml
@@ -523,19 +576,24 @@ sub printer
no strict;
local *res = shift;
my ($iseval, $wantarray) = @_;
- @__ = @res;
+ @::__ = @res;
+ $::__ = @res == 1 ? $res[0] : [@res];
my $str;
if ($iseval) {
- $::__ = "@res";
+ $res = "@res";
} elsif (@res == 1 && (ref $res[0]) =~ /^PDL/) {
- $::__ = "$res[0]";
+ $res = $res[0];
+ } elsif (!$iseval && $PRINT_PRETTY && @res > 1 && grep !ref $_, @res) {
+ $res = columnate(sort @res);
+ print $res;
+ return;
} else {
- $::__ = $PRINTER->();
+ $res = $PRINTER->();
}
if ($iseval) {
- print ';;;', length $::__, "\n$::__\n";
+ print ';;;', length $res, "\n$::__\n";
} else {
- print "=> $::__\n";
+ print "=> $res\n";
}
}
@@ -570,6 +628,11 @@ Behavior is controlled in part through the following package-globals:
=item C<$WANTARRAY> -- evaluation context
+=item C<$PRINT_PRETTY> -- format some output nicely (default = 0)
+
+Format some values nicely, independent of $PRINTER. Currently, this
+displays arrays of scalars as columns.
+
=item C<%REPL> -- maps shortcut names to handlers
=item C<%REPL_DOC> -- maps shortcut names to documentation
@@ -587,6 +650,7 @@ BEGIN {
$PACKAGE = 'main';
$WANTARRAY = 1;
$PRINTER = \&Sepia::print_dumper;
+ $PRINT_PRETTY = 0;
%REPL = (help => \&Sepia::repl_help,
cd => \&Sepia::repl_chdir,
methods => \&Sepia::repl_methods,
@@ -599,14 +663,16 @@ BEGIN {
);
%REPL_DOC = (
cd =>
- 'cd DIR Change directory to DIR',
+ 'cd DIR Change directory to DIR',
format =>
'format [dumper|dump|yaml|plain]
Set output formatter (default: dumper)',
help =>
'help Display this message',
- methods =>
- 'methods X List methods for reference or package X',
+ methods => <<EOS,
+methods X [RE] List methods for reference or package X,
+ matching optional pattern RE.
+EOS
package =>
'package PACKAGE Set evaluation package to PACKAGE',
quit =>
@@ -615,8 +681,10 @@ BEGIN {
'strict [0|1] Turn \'use strict\' mode on or off',
wantarray =>
'wantarray [0|1] Set or toggle evaluation context',
- who =>
- 'who PACKAGE List variables and subs in PACKAGE',
+ who => <<EOS,
+who PACKAGE [RE] List variables and subs in PACKAGE matching optional
+ pattern RE.
+EOS
);
%RK = abbrev keys %REPL;
}
@@ -711,8 +779,8 @@ sub repl_chdir
sub who
{
- my ($pack, $re) = (shift =~ /^(\S+)(?:\s+(\S.*))?/);
- $re ||= '';
+ my ($pack, $re) = @_;
+ $re ||= '.?';
$re = qr/$re/;
no strict;
sort grep /$re/, map {
@@ -733,40 +801,50 @@ sub columnate
$len = length if $len < length;
}
my $nc = int($width / ($len+1)) || 1;
- my $nr = @_ / $nc + (@_ % $nc ? 1 : 0);
- my $fmt = ('%-'.($len+1).'s') x $nc . "\n";
+ my $nr = int(@_ / $nc) + (@_ % $nc ? 1 : 0);
+ my $fmt = ('%-'.($len+1).'s') x ($nc-1) . "%s\n";
my @incs = map { $_ * $nr } 0..$nc-1;
my $str = '';
- for my $r (0..$nr) {
+ for my $r (0..$nr-1) {
$str .= sprintf $fmt, map { $_ || '' } @_[map { $r + $_ } @incs];
}
+ $str =~ s/ +$//m;
$str
}
sub repl_who
{
- print columnate who @_;
+ my ($pkg, $re) = split ' ', shift;
+ print columnate who($pkg || $PACKAGE, $re);
0;
}
sub methods
{
- my $pack = shift;
+ my ($pack, $qualified) = @_;
no strict;
- (grep(defined &{"$pack\::$_"}, keys %{$pack.'::'}),
- defined @{$pack.'::ISA'} ? (map methods($_), @{$pack.'::ISA'}) : ());
+ my @own = $qualified ? grep {
+ defined *{$_}{CODE}
+ } map { "$pack\::$_" } keys %{$pack.'::'}
+ : grep {
+ defined *{"$pack\::$_"}{CODE}
+ } keys %{$pack.'::'};
+ (@own, defined @{$pack.'::ISA'}
+ ? (map methods($_, $qualified), @{$pack.'::ISA'}) : ());
}
sub repl_methods
{
- my $x = shift;
+ my ($x, $re) = split ' ', shift;
$x =~ s/^\s+//;
$x =~ s/\s+$//;
if ($x =~ /^\$/) {
- $x = eval "ref $x";
- return 1 if $@;
+ $x = repl_eval("ref $x");
+ return 0 if $@;
}
- Sepia::printer [methods $x];
+ $re ||= '.?';
+ $re = qr/$re/;
+ print columnate sort { $a cmp $b } grep /$re/, methods $x;
0;
}
@@ -806,7 +884,7 @@ sub debug_help
{
print <<EOS;
Inspector commands (prefixed with ','):
- \\C-c Pop one debugger level
+ ^C Pop one debugger level
backtrace show backtrace
inspect N ... inspect lexicals in frame(s) N ...
eval N EXPR evaluate EXPR in lexical environment of frame N
@@ -873,6 +951,8 @@ sub repl
help => \&Sepia::debug_help,
);
local *CORE::GLOBAL::die = sub {
+ ## Protect us against people doing weird things.
+ CORE::die(@_) if $SIG{__DIE__} ne 'DEFAULT';
my @dieargs = @_;
if ($STOPDIE) {
local $dies = $dies+1;
@@ -881,7 +961,7 @@ sub repl
local %Sepia::REPL = (
%dhooks, die => sub { local $Sepia::STOPDIE=0; die @dieargs });
local %Sepia::RK = abbrev keys %Sepia::REPL;
- print "@_\nDied $MSG\n";
+ print "@_\nDied $MSG\n\tin ".caller;
return Sepia::repl($fh, 1);
}
CORE::die(@_);
@@ -900,7 +980,7 @@ sub repl
}
CORE::warn(@_);
};
- print <<EOS;
+ print <<EOS if $dies == 0;
Sepia version $Sepia::VERSION.
Press ",h" for help, or "^D" or ",q" to exit.
EOS
@@ -916,6 +996,7 @@ EOS
next repl;
}
$buf .= $in;
+ $buf =~ s/^\s*//;
my $iseval;
if ($buf =~ /^<<(\d+)\n(.*)/) {
$iseval = 1;
@@ -974,8 +1055,9 @@ EOS
}
}
}
- if ($buf !~ /;$/) {
- ## Be quiet if it ends with a semicolon.
+ if ($buf !~ /;$/ && $buf !~ /^,/) {
+ ## Be quiet if it ends with a semicolon, or if we
+ ## executed a shortcut.
Sepia::printer \@res, $iseval, wantarray;
}
$buf = '';
diff --git a/lib/Sepia/Xref.pm b/lib/Sepia/Xref.pm
index c496649..b17fc43 100644
--- a/lib/Sepia/Xref.pm
+++ b/lib/Sepia/Xref.pm
@@ -30,7 +30,7 @@ most of its code.
=cut
BEGIN { *_apropos_re = *Sepia::_apropos_re; }
-$VERSION = '0.64';
+$VERSION = '0.65';
use strict;
use Config;
@@ -429,7 +429,7 @@ sub pp_method_named {
$top = [$lastclass || "(method)", '->', $name];
undef $lastclass;
} else {
- warn "method_named: wtf: sizeof padval = ". at padval;
+ dprint 'method_named', "method_named: wtf: sizeof padval = ". at padval;
}
}
diff --git a/sepia-w3m.el b/sepia-w3m.el
index fb26783..d38398c 100644
--- a/sepia-w3m.el
+++ b/sepia-w3m.el
@@ -67,17 +67,9 @@
;;;###autoload
(defun sepia-w3m-view-pod (&optional buffer)
- "View POD for the current buffer."
- (interactive)
(w3m-goto-url (concat "about://perldoc-buffer/"
(w3m-url-encode-string (buffer-name buffer)))))
-;;;###autoload
-(defun sepia-w3m-perldoc-this (mod)
- "View perldoc for module at point."
- (interactive (list (sepia-interactive-arg 'module)))
- (w3m-perldoc mod))
-
(defun sepia-module-list ()
"List installed modules with links to their documentation.
diff --git a/sepia.el b/sepia.el
index edef7ce..278da31 100644
--- a/sepia.el
+++ b/sepia.el
@@ -28,6 +28,24 @@
(defvar sepia-program-name "perl"
"* Perl program name.")
+(defvar sepia-perldoc-function
+ (if (featurep 'w3m) 'w3m-perldoc 'cperl-perldoc)
+"* Function to view modules' documentation.
+
+Useful values include `w3m-perldoc' and `cperl-perldoc'.")
+
+(defvar sepia-view-pod-function
+ (if (featurep 'w3m) 'sepia-w3m-view-pod 'sepia-perldoc-buffer)
+"* Function to view modules' documentation.
+
+Useful values include `sepia-w3m-view-pod' and `sepia-perldoc-buffer'.")
+
+(defvar sepia-module-list-function
+ (if (featurep 'w3m) 'w3m-find-file 'browse-url-of-buffer)
+"* Function to view a list of installed modules.
+
+Useful values include `w3m-find-file' and `browse-url-of-buffer'.")
+
(defvar sepia-process nil
"The perl process with which we're interacting.")
(defvar sepia-output nil
@@ -184,11 +202,10 @@ subs from the evaluation package, it may not always work.")
("r" . sepia-rebuild)
("m" . sepia-module-find)
("n" . sepia-next)
- ("t" . find-tag)))
+ ("t" . find-tag)
+ ("d" . sepia-perldoc-this)))
(define-key km (car kv) (cdr kv)))
- (when (featurep 'sepia-w3m)
- (define-key km "d" 'sepia-w3m-perldoc-this))
- (when (featurep 'sepia-ido)
+ (when (featurep 'ido)
(define-key km "j" 'sepia-jump-to-symbol))
km))
"Keymap for Sepia functions. This is just an example of how you
@@ -203,9 +220,54 @@ might want to bind your keys, which works best when bound to
(define-key map "\M-," 'sepia-next)
(define-key map "\C-\M-x" 'sepia-eval-defun)
(define-key map "\C-c\C-l" 'sepia-load-file)
- (define-key map "\C-c\C-d" 'sepia-w3m-view-pod)
+ (define-key map "\C-c\C-d" 'sepia-view-pod)
(define-key map (kbd "TAB") 'sepia-indent-or-complete)))
+;;;###autoload
+(defun sepia-perldoc-this (name)
+ "View perldoc for module at point."
+ (interactive (list (sepia-interactive-arg 'module)))
+ (funcall sepia-perldoc-function name))
+
+(defun sepia-view-pod ()
+ "View POD for the current buffer."
+ (interactive)
+ (funcall sepia-view-pod-function))
+
+(defun sepia-module-list ()
+ "List installed modules with links to their documentation.
+
+This lists not just top-level packages appearing in packlist
+files, but all documented modules on the system, organized by
+package."
+ (interactive)
+ (let ((file "/tmp/modlist.html"))
+ (unless (file-exists-p file)
+ (sepia-eval (format "Sepia::html_module_list(\"%s\")" file)))
+ (funcall sepia-module-list-function file)))
+
+(defun sepia-package-list ()
+ "List installed packages with links to their documentation.
+
+This lists only top-level packages appearing in packlist files.
+For modules within packages, see `sepia-module-list'."
+ (interactive)
+ (let ((file "/tmp/packlist.html"))
+ (unless (file-exists-p file)
+ (sepia-eval (format "Sepia::html_package_list(\"%s\")" file)))
+ (funcall sepia-module-list-function file)))
+
+(defun sepia-perldoc-buffer ()
+ "View current buffer's POD using pod2html and `browse-url'."
+ (let ((buffer (get-buffer-create "*sepia-pod*"))
+ (errs (get-buffer-create "*sepia-pod-errors*"))
+ (inhibit-read-only t))
+ (with-current-buffer buffer (erase-buffer))
+ (save-window-excursion
+ (shell-command-on-region (point-min) (point-max) "pod2html"
+ buffer nil errs))
+ (with-current-buffer buffer (browse-url-of-buffer))))
+
(defun perl-name (sym &optional mod)
"Convert a Perl name to a Lisp name."
(setq sym (substitute ?_ ?- (if (symbolp sym) (symbol-name sym) sym)))
@@ -226,7 +288,7 @@ In addition to these keys, Sepia defines the following keys,
which may conflict with keys in your setup, but which are
intended to shadow similar functionality in elisp-mode:
-`\\C-c\\C-d' ``sepia-w3m-view-pod''
+`\\C-c\\C-d' ``sepia-view-pod''
`\\C-c\\C-l' ``sepia-load-file''
`\\C-\\M-x' ``sepia-eval-defun''
`\\M-,' ``sepia-next'' (shadows ``tags-loop-continue'')
@@ -271,6 +333,7 @@ Does not require loading.")
;; Create low-level wrappers for Sepia
(dolist (x '((completions "Find completions in the symbol table.")
+ (method-completions "Complete on an object's methods.")
(location "Find an identifier's location.")
(mod-subs "Find all subs defined in a package.")
(mod-decls "Generate declarations for subs in a package.")
@@ -353,6 +416,8 @@ module in question be loaded.")))
(defvar sepia-sub-re "^\\s *sub\\s +\\(.+\\_>\\)")
+(defvar sepia-history nil)
+
(defun sepia-interactive-arg (&optional type)
"Default argument for most Sepia functions. TYPE is a symbol --
either 'file to look for a file, or anything else to use the
@@ -409,6 +474,8 @@ symbol at point."
`(let ((it ,test))
(if it ,then , at else)))
+(defvar sepia-found-refiner)
+
(defun sepia-show-locations (locs)
(when locs
(pop-to-buffer (get-buffer-create "*sepia-places*"))
@@ -568,7 +635,7 @@ to this location."
(list (sepia-location obj)))
(t
(setq module-doc-p t)
- `((,(sepia-w3m-perldoc-this obj) 1 nil nil))))))
+ `((,(sepia-perldoc-this obj) 1 nil nil))))))
(unless module-doc-p
(if display-p
(sepia-show-locations ret)
@@ -679,8 +746,6 @@ also rebuild the xref database."
(defvar sepia-found)
(defvar sepia-found-head)
-(defvar sepia-found-refiner)
-(defvar sepia-history nil)
(defun sepia-set-found (list &optional type)
(setq list
@@ -752,6 +817,60 @@ also rebuild the xref database."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Completion
+(defun sepia-ident-before-point ()
+ "Find the Perl identifier at or preceding point."
+ (save-excursion
+ (when (looking-at "[%$@*&]")
+ (forward-char 1))
+ (let* ((end (point))
+ (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)))))
+ (list (when (member sigil '(?$ ?@ ?% ?* ?&)) sigil)
+ (buffer-substring-no-properties beg end)))))
+
+(defvar sepia-complete-methods t
+"* Non-nil if Sepia should try to complete methods for \"$x->\".
+
+NOTE: this feature can be problematic, since it evaluates the
+object in order to find its type. Currently completion is only
+attempted for objects that are simple scalars.")
+
+(defun sepia-simple-method-before-point ()
+ "Find the \"simple\" method call before point.
+
+Looks for a simple method called on a variable before point and
+returns the list (OBJECT METHOD). For example, \"$x->blah\"
+returns '(\"$x\" \"blah\"). Only simple methods are recognized,
+because completing anything evaluates it, so completing complex
+expressions would lead to disaster."
+ (when sepia-complete-methods
+ (let ((end (point))
+ (bound (max (- (point) 100) (point-min)))
+ arrow beg)
+ (save-excursion
+ ;; XXX - can't do this because COMINT's syntax table is weird.
+ ;; (skip-syntax-backward "_w")
+ (skip-chars-backward "a-zA-Z0-9_")
+ (when (looking-back "->\\s *" bound)
+ (setq arrow (search-backward "->" bound))
+ (skip-chars-backward "a-zA-Z0-9_:")
+ (cond
+ ;; $x->method
+ ((char-equal (char-before (point)) ?$)
+ (setq beg (1- (point))))
+ ;; X::Class->method
+ ((looking-at "[A-Z][a-z]")
+ (setq beg (point))))
+ (when beg
+ (list (buffer-substring-no-properties beg arrow)
+ (buffer-substring-no-properties (+ 2 arrow) end)
+ (buffer-substring-no-properties beg end))))))))
+
(defun sepia-ident-at-point ()
"Find the Perl identifier at point."
(save-excursion
@@ -800,10 +919,15 @@ annoying in larger programs.
The function is intended to be bound to \\M-TAB, like
``lisp-complete-symbol''."
(interactive)
- (let ((win (get-buffer-window "*Completions*" 0)))
+ (let ((win (get-buffer-window "*Completions*" 0))
+ len
+ completions
+ type
+ meth)
(if (and (eq last-command this-command)
win (window-live-p win) (window-buffer win)
(buffer-name (window-buffer win)))
+
;; If this command was repeated, and
;; there's a fresh completion window with a live buffer,
;; and this command is repeated, scroll that window.
@@ -814,43 +938,57 @@ The function is intended to be bound to \\M-TAB, like
(select-window win)
(scroll-up))))
- (multiple-value-bind (type name) (sepia-ident-at-point)
- (let ((len (+ (if type 1 0) (length name)))
- (completions (xref-completions
- name
- (case type
- (?$ "SCALAR")
- (?@ "ARRAY")
- (?% "HASH")
- (?& "CODE")
- (?* "IO")
- (t ""))
- (and (not (eq major-mode 'comint-mode))
- (sepia-function-at-point)))))
- (when (and (not completions)
- (or (not type) (eq type ?&)))
- (when (string-match ".*::([^:]+)$" name)
- (setq name (match-string 1 name)))
- (setq completions (all-completions name sepia-perl-builtins)))
- (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))
- ;; Hide stale completions buffer (stolen from lisp.el).
- (if win (with-selected-window win (bury-buffer)))
- t)
- (t (let ((old name)
- (new (try-completion "" completions)))
- (if (string= new old)
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list completions))
- (let ((win (get-buffer-window "*Completions*" 0)))
- (if win (with-selected-window win (bury-buffer))))
- (delete-region (- (point) len) (point))
- (insert (if type (string type) "") new)))
- t)))
- ))))
+ ;; Otherwise actually do completion:
+ ;; 1 - Look for a method call:
+ (setq meth (sepia-simple-method-before-point))
+ (when meth
+ (setq len (length (caddr meth))
+ completions (xref-method-completions
+ (cons 'expr (format "'%s'" (car meth)))
+ (cadr meth)
+ "Sepia::repl_eval")
+ type (format "%s->" (car meth))))
+ (multiple-value-bind (typ name) (sepia-ident-before-point)
+ ;; 2 - look for a regular function/variable/whatever
+ (unless completions
+ (setq type typ
+ len (+ (if type 1 0) (length name))
+ completions (xref-completions
+ name
+ (case type
+ (?$ "VARIABLE")
+ (?@ "ARRAY")
+ (?% "HASH")
+ (?& "CODE")
+ (?* "IO")
+ (t ""))
+ (unless (eq major-mode 'comint-mode)
+ (sepia-function-at-point)))))
+ ;; 3 - try a Perl built-in
+ (when (and (not completions)
+ (or (not type) (eq type ?&)))
+ (when (string-match ".*::([^:]+)$" name)
+ (setq name (match-string 1 name)))
+ (setq completions (all-completions name sepia-perl-builtins)))
+ (case (length completions)
+ (0 (message "No completions for %s." name) nil)
+ (1 ;; XXX - skip sigil to match s-i-before-point
+ (when (looking-at "[%$@*&]")
+ (forward-char 1))
+ (delete-region (- (point) len) (point))
+ (insert (or type "") (car completions))
+ ;; Hide stale completions buffer (stolen from lisp.el).
+ (if win (with-selected-window win (bury-buffer))) t)
+ (t (let ((old name)
+ (new (try-completion "" completions)))
+ (if (string= new old)
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list completions))
+ (let ((win (get-buffer-window "*Completions*" 0)))
+ (if win (with-selected-window win (bury-buffer))))
+ (delete-region (- (point) len) (point))
+ (insert (or type "") new))))))
+ t)))
(defvar sepia-indent-expand-abbrev t
"* If non-NIL, `sepia-indent-or-complete' tries `expand-abbrev'.")
@@ -865,12 +1003,12 @@ This function is intended to be bound to TAB."
(let (beginning-of-defun-function
end-of-defun-function)
(cperl-indent-command))
- (unless (or (not sepia-indent-expand-abbrev)
- (expand-abbrev))
- (when (and (= pos (point))
- (not (bolp))
- (or (eq last-command 'sepia-indent-or-complete)
- (looking-at "\\_>")))
+ (when (and (= pos (point))
+ (not (bolp))
+ (or (eq last-command 'sepia-indent-or-complete)
+ (looking-at "\\_>")))
+ (when (or (not sepia-indent-expand-abbrev)
+ (expand-abbrev))
(sepia-complete-symbol)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -961,6 +1099,21 @@ With prefix arg, replace the region with the result."
(concat "; do { " expr ";}; $_ }")
beg end replace-p))
+(defun sepia-core-version (module &optional message)
+ "Report the first version of Perl shipping with MODULE."
+ (interactive (list (read-string "Module: "
+ nil nil (sepia-thing-at-point 'symbol))
+ t))
+ (let* ((version
+ (sepia-eval
+ (format "eval { Sepia::core_version('%s') }" module)
+ 'scalar-context))
+ (res (if version
+ (format "%s was first released in %s." module version)
+ (format "%s is not in core." module))))
+ (when message (message "%s" res))
+ res))
+
(defun sepia-guess-package (sub &optional file)
"Guess which package SUB is defined in."
(let ((defs (xref-location (xref-apropos sub))))
@@ -1097,42 +1250,51 @@ used for eldoc feedback."
(puthash (second x) (third x) map)
(puthash (concat pack (second x)) (third x) map)))))
-(defun sepia-symbol-info ()
+(defun sepia-symbol-info (&optional obj type)
"Eldoc function for Sepia-mode.
Looks in ``sepia-doc-map'' and ``sepia-var-doc-map'', then tries
calling ``cperl-describe-perl-symbol''."
- (save-excursion
- (multiple-value-bind (type obj) (sepia-ident-at-point)
- (when (consp obj)
- (setq obj (car obj)))
- (unless type
- (setq type 'function))
- (if (and obj (member type '(function variable module)))
- (or (gethash obj (ecase (or type 'function)
- (function sepia-doc-map)
- (variable sepia-var-doc-map)
- (module sepia-module-doc-map)))
- ;; Loathe cperl a bit.
-
- (flet ((message (&rest blah) (apply #'format blah)))
- (let* ((cperl-message-on-help-error nil)
- (hlp (car (cperl-describe-perl-symbol obj))))
- (when hlp
- ;; cperl's docstrings are too long.
- (setq hlp (replace-regexp-in-string "\\s \\{2,\\}" " " hlp))
- (if (> (length hlp) 75)
- (concat (substring hlp 0 72) "...")
- hlp)))))
- ""))))
+ (unless obj
+ (multiple-value-bind (ty ob) (sepia-ident-at-point)
+ (setq obj (if (consp ob) (car ob) ob)
+ type ty)))
+ (if obj
+ (or (gethash obj (ecase (or type ?&)
+ (?& sepia-doc-map)
+ ((?$ ?@ ?%) sepia-var-doc-map)
+ (nil sepia-module-doc-map)))
+ ;; Loathe cperl a bit.
+ (flet ((message (&rest blah) (apply #'format blah)))
+ (let* (case-fold-search
+ (cperl-message-on-help-error nil)
+ (hlp (car (cperl-describe-perl-symbol obj))))
+ (if hlp
+ (progn
+ ;; cperl's docstrings are too long.
+ (setq hlp (replace-regexp-in-string "\\s \\{2,\\}" " " hlp))
+ (if (> (length hlp) 75)
+ (concat (substring hlp 0 72) "...")
+ hlp))
+ ;; Try to see if it's a module
+ (if (or (string-match "^\\([A-Z].*::\\)?[A-Z]+[a-z]+\\sw*$" obj)
+ (string-match (eval-when-compile
+ (regexp-opt '("strict"
+ "vars"
+ "warnings"
+ "lib"))) obj))
+ (sepia-core-version obj)
+ ""))))
+ "")))
(defun sepia-install-eldoc ()
"Install Sepia hooks for eldoc support."
(interactive)
+ (require 'eldoc)
(set-variable 'eldoc-documentation-function 'sepia-symbol-info t)
(if cperl-lazy-installed (cperl-lazy-unstall))
(eldoc-mode 1)
- (setq eldoc-idle-delay 1.0))
+ (set-variable 'eldoc-idle-delay 1.0 t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Error jump:
@@ -1182,9 +1344,12 @@ calling ``cperl-describe-perl-symbol''."
(if (member type '(?% ?$ ?@ ?*))
pname
(concat "\\*" pname))))
- ((stringp thing) (format "\"%s\"" thing))
+ ((stringp thing) (format "\'%s\'" thing))
((integerp thing) (format "%d" thing))
((numberp thing) (format "%g" thing))
+ ;; Perl expression
+ ((and (consp thing) (eq (car thing) 'expr))
+ (cdr thing)) ; XXX -- need quoting??
((and (consp thing) (not (consp (cdr thing))))
(concat (sepia-lisp-to-perl (car thing)) " => "
(sepia-lisp-to-perl (cdr thing))))
diff --git a/test.pl b/test.pl
index e6d653a..c11e049 100644
--- a/test.pl
+++ b/test.pl
@@ -1,5 +1,5 @@
#!/usr/bin/env perl
-use Test::Simple tests => 22;
+use Test::Simple tests => 18;
require Data::Dumper;
require Sepia;
@@ -16,15 +16,10 @@ sub all
$ok;
}
-my @loc1 = @{(Sepia::location->('location'))[0]};
-ok(@loc1 || 1, 'location 1');
-my @loc2 = @{(Sepia::location->('Sepia::location'))[0]};
-ok(@loc2 || 1, 'fullname location');
-ok(all(map { $loc1[$_] eq $loc2[$_] } 0..$#loc1), 'sameness');
-ok(1 || $loc1[0] =~ /Sepia\.pm$/, "file: $loc1[0]");
-ok(1 || $loc1[1] =~ /^\d+$/, "line: $loc1[1]");
-ok(1 || $loc1[2] eq 'location', "name: $loc1[2]");
-
+my @loc1 = Sepia::location('Sepia::location');
+ok($loc1[0][0] =~ /Sepia\.pm$/, 'location');
+ok((grep { $_ eq 'Sepia::location' } Sepia::apropos('location')), 'apropos');
+# 4 to here
sub apply_to_loc # 3 tests per call.
{
my $f = shift;
@@ -37,22 +32,32 @@ sub apply_to_loc # 3 tests per call.
$loc1;
}
-# 8 tests to here.
apply_to_loc(\&Sepia::Xref::callers);
apply_to_loc(\&Sepia::Xref::callees);
+# 10 tests to here.
my @subs = Sepia::mod_subs('Sepia');
ok(all(map { defined &{"Sepia::$_"} } @subs), 'mod_subs');
-# 15 to here
ok(Sepia::module_info('Sepia', 'name') eq 'Sepia');
ok(Sepia::module_info('Sepia', 'version') eq $Sepia::VERSION);
ok(Sepia::module_info('Sepia', 'file') =~ /Sepia\.pm$/);
ok(Sepia::module_info('Sepia', 'is_core') == 0);
-my @mu = sort(Sepia::module_info('Sepia', 'modules_used'));
-my @mu_exp = qw(B Cwd Exporter Module::Info strict);
-ok(1 || all(map { $mu[$_] eq $mu_exp[$_] } 0..$#mu), "@mu");
-ok((Sepia::module_info('Sepia', 'packages_inside'))[0] eq 'Sepia');
-ok((Sepia::module_info('Sepia', 'superclasses'))[0] eq 'Exporter');
-# 22 to here
+
+if (exists $INC{'Module/Info.pm'}) {
+ my %mu;
+ undef @mu{Sepia::module_info('Sepia', 'modules_used')};
+
+ my @mu_exp = ('B', 'Carp', 'Cwd', 'Exporter', 'Module::Info',
+ 'Scalar::Util', 'Text::Abbrev', 'strict', 'vars');
+
+ ok(all(map { exists $mu{$_} } @mu_exp), "uses (@mu_exp)");
+ ok((Sepia::module_info('Sepia', 'packages_inside'))[0] eq 'Sepia');
+ ok((Sepia::module_info('Sepia', 'superclasses'))[0] eq 'Exporter');
+} else {
+ ok(1, "no module info");
+ ok(1, "no module info");
+ ok(1, "no module info");
+}
+# 18 to here.
exit;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/sepia.git
More information about the Pkg-perl-cvs-commits
mailing list