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 <ben...@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 <sorou...@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 <sorou...@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 <sorou...@cs.ucsd.edu> + + * lib/Sepia.pm (repl_methods): fixed. + 2007-05-26 Sean O'Rourke <sorou...@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 <sorou...@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 <ben...@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 = ".@padval; + dprint 'method_named', "method_named: wtf: sizeof padval = ".@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 ,@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 _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits