[sepia] 17/63: Imported Debian patch 0.96-1
Hilko Bengen
bengen at moszumanska.debian.org
Sat Aug 8 11:20:34 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 d147cb544648a538081e100d1ef29c9825b1be81
Author: Hilko Bengen <bengen at debian.org>
Date: Wed Dec 19 15:23:24 2007 +0100
Imported Debian patch 0.96-1
---
._ChangeLog | Bin 176 -> 0 bytes
ChangeLog | 150 ++++++++++-
MANIFEST | 2 +
META.yml | 24 +-
Makefile.PL | 58 +++--
README | 13 +-
Sepia.html | 267 +++++++++++++++++---
debian/changelog | 6 +
debian/control | 2 +-
lib/._Sepia.pm | Bin 178 -> 0 bytes
lib/Sepia.pm | 720 ++++++++++++++++++++++++++++++++---------------------
lib/Sepia/Debug.pm | 210 ++++++----------
lib/Sepia/Xref.pm | 17 +-
sepia-ido.el | 8 +-
sepia-snippet.el | 18 ++
sepia-tree.el | 34 +--
sepia-w3m.el | 36 ++-
sepia.el | 471 ++++++++++++++++++++---------------
sepia.texi | 70 +++++-
t/01basic.t | 31 +--
t/02completion.t | 59 +++++
t/50expect.t | 36 ++-
22 files changed, 1471 insertions(+), 761 deletions(-)
diff --git a/._ChangeLog b/._ChangeLog
deleted file mode 100644
index e20148b..0000000
Binary files a/._ChangeLog and /dev/null differ
diff --git a/ChangeLog b/ChangeLog
index 0bd3b48..b16af75 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,141 @@
+2007-12-13 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * sepia.el (sepia-complete-symbol): add shortcut completion.
+ improve XEmacs compatibility.
+ * sepia-w3m.el (sepia-w3m-create-imenu): new function, disabled by
+ default.
+ * lib/Sepia.pm (repl_*): don't look at return values; use "last
+ repl" to get out.
+
+2007-11-29 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * t/02completion.t: new completion tests.
+ * lib/Sepia.pm (completions): rewrote to simplify.
+
+2007-11-28 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * lib/Sepia.pm (printer): Don't sort arrays when printing.
+ * VERSION: 0.95_02
+ * lib/sepia/Debug.pm (warn,die): use Carp for 5.10 compatibility.
+ * Makefile.PL (test_for): $|=1 if prompting.
+
+2007-11-27 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * sepia.el (sepia-perldoc-this): test for w3m when called.
+
+ * VERSION: 0.95_01
+ * t/01basic.t (Sepia): fix tests w/o Module::Info.
+
+2007-11-26 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * VERSION: 0.95
+ * lib/sepia/Debug.pm (add_repl_commands): use define_shortcut.
+ (warn,die): same.
+ (add_debug_repl_commands): new function.
+ (repl): use it.
+
+ * lib/Sepia.pm (define_shortcut): new function.
+ (define_shortcut): new function.
+ (repl_help): auto-format help text; add arg.
+ (repl_reload): decrement $REPL_LEVEL.
+ (completions): fix abbrev completion.
+ (repl): read ~/.sepiarc; use define_shortcuts.
+ (repl_format): show current if no argument.
+ (module_info): optional dependency.
+
+2007-11-08 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * VERSION: 0.94_01
+ * lib/Sepia/Xref.pm: POD fixup.
+ * sepia.el (sepia-ensure-process): fix stupid attachtty mistake.
+
+2007-11-05 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * lib/sepia/Debug.pm (repl_break): allow "0" as a break condition.
+
+2007-10-31 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * lib/Sepia.pm (repl_size): ",size" command to list variable sizes,
+ like Matlab's "whos".
+
+2007-10-16 Sean O'Rourke <seano at cs.ucla.edu>
+
+ * VERSION: 0.93
+
+ * lib/Sepia.pm (repl_pwd): add ",pwd" shortcut.
+ (repl_who): use current package when only regex given.
+
+ * sepia.el (sepia-repl,sepia-ensure-process): add remote
+ connection with attachtty.
+ (sepia-shared-map): bind \C-c\C-e to eval-expression.
+ (sepia-symbol-info): be more selective about "core version".
+
+2007-09-25 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * lib/Sepia.pm (printer): remove "=>" -- it's annoying.
+
+2007-09-21 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * sepia.el (sepia-load-file): disable debugger.
+ (sepia-symbol-info): be pickier about module core versions.
+
+2007-09-20 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * lib/Sepia.pm (repl_who): use current package if only one arg
+ given, and it's not an existing package.
+
+2007-09-18 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * sepia.el (sepia-watch-for-eval): fix hang with recursive sepia-eval.
+
+2007-07-25 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * sepia.el (sepia-interactive-arg): use xref-completions rather
+ than xref-apropos for working completion.
+
+2007-07-25 Ye Wenbin <wenbinye at gmail.com>
+
+ * sepia.el (sepia-defun-around-point): change the command to a
+ function, because as a command it does nothing.
+ (define-modinfo-function, sepia-maybe-echo): the interactive-p
+ is not true when call as function.
+ (define-modinfo-function, sepia-init): some modinfo-function
+ should eval in a list-context.
+ (sepia-mode): use cperl-mode-abbrev-table as current local-abbrev-table
+
+2007-07-24 Ye Wenbin <wenbinye at gmail.com>
+
+ * sepia.el (sepia-set-found): Use (OFFSET . LIST) to represent
+ things that found.
+ (sepia-next, sepia-previous): more generic move commands
+ (sepia-refiner): remove the test, because sometimes use the
+ same declaration, but found in difference place.
+
+ * sepia-tree.el (sepia-tree-button-cb): widget => pw and
+ xref-location return a list of posible locations.
+ (sepia-tree-tidy-buffer, sepia-tree-use-image): Let user
+ to choose whether use image or not. Set it to a buffer-local
+ variable, so that it didn't interference global values.
+
+ * sepia.el (sepia-extract-def): seem an argument is excessive
+
+ * sepia-tree.el (sepia-build-tree-buffer): In my emacs, it
+ doesn't work. The :dynargs didn't become the tree-widget
+ :expander. The tree-widget-convert-widget only receive the
+ 'tree-widget, not the total list.
+ sepia-install-keys not defined.
+
+ * lib/Sepia/Xref.pm (file_modules): seem it is a typo error to use
+ Module::Include rather than Module::Info.
+ Module::Info::packages_inside return an array, the operator
+ || will force in a scalar context.
+
+ * sepia.el (sepia-lisp-to-perl): use "'" to quote string is not
+ enough, because the string may also contain "'" inside.
+ use (format "%S" string) instead.
+ (define-sepia-query): `sepia-set-found' accept a symbol as
+ argument, not (quote symbol).
+
2007-06-09 Sean O'Rourke <sorourke at cs.ucsd.edu>
* VERSION: 0.92
@@ -164,7 +302,7 @@
* VERSION: 0.70
* README: add license.
* Makefile.PL: remove dependency on Sub::Uplevel, make PadWalker
- optional.
+ optional.
* lib/Sepia.pm (who): add optional regex filter.
(debug_inspect): fix non-scalar printing.
* sepia.el (sepia-dwim): fix staleness; change to find
@@ -361,7 +499,7 @@
* Xref.pm: Localize a bunch of things instead of stomping on
package lexicals. This makes the module better handle repeated
use, for which it wasn't designed.
-
+
* Xref.pm (mod_subs): Rename package_subs for consistency.
(mod_decls): New function to generate decls for evaluation.
@@ -393,7 +531,7 @@
* sepia.el (sepia-eval-defun,sepia-eval-buffer): new functions.
* test.pl: satisfy the cpants Fascists.
-
+
* Xref.pm (use_type): try to be smarter about when something's
being assigned to, vs. merely used as a reference.
@@ -410,10 +548,10 @@
2004-04-04 Sean O'Rourke <seano at cs.ucsd.edu>
* Sepia.jpg: don't ask -- just look.
-
+
* sepia.el (sepia-ident-at-point): fixed bug with sigils.
(sepia-complete-symbol): fixed bug with undefined function
- sepia-end-of-word.
+ sepia-end-of-word.
Always use Data::Dumper.
* any-repl.el: new file implementing REPL, basically stolen from
@@ -443,5 +581,5 @@
ignored for now); fix line number refinement to be a
little less over-eager; fix pscope-callees to go to sub
definitions instead of call sites.
-
+
* README: added TODO section.
diff --git a/MANIFEST b/MANIFEST
index a697d0c..c20e5e7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -8,11 +8,13 @@ lib/Sepia.pm
lib/Sepia/Xref.pm
lib/Sepia/Debug.pm
sepia-ido.el
+sepia-snippet.el
sepia-tree.el
sepia-w3m.el
sepia.el
sepia.texi
t/01basic.t
+t/02completion.t
t/50expect.t
t/testy.pl
ChangeLog
diff --git a/META.yml b/META.yml
index 9828577..fa995c1 100644
--- a/META.yml
+++ b/META.yml
@@ -1,16 +1,12 @@
---- #YAML:1.0
-name: Sepia
-version: 0.92
-abstract: Simple Emacs-Perl InterAction
-license: perl
-generated_by: ExtUtils::MakeMaker version 6.31
-distribution_type: module
-requires:
- B::Module::Info: 0
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Sepia
+version: 0.96
+version_from: lib/Sepia.pm
+installdirs: site
+requires:
Data::Dumper: 0
Scalar::Util: 0
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
-author:
- - Sean O'Rourke <seano at cpan.org>
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30
diff --git a/Makefile.PL b/Makefile.PL
index aa2b0a4..2c35bcb 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,34 +3,52 @@ use 5.006; # for "no warnings" -- sorry!
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'Sepia',
- 'VERSION_FROM' => 'lib/Sepia.pm', # finds $VERSION
- 'PREREQ_PM' => { 'Data::Dumper' => 0,
- 'B::Module::Info' => 0,
- 'Scalar::Util' => 0,
- },
- AUTHOR => "Sean O'Rourke <seano\@cpan.org>",
- ABSTRACT => 'Simple Emacs-Perl InterAction',
- LICENSE => 'perl',
-);
-
print <<EOS;
-NOTE: To actually use this package in a useful way, you probably need
-to move the Emacs Lisp files somewhere. Where will depend on your
-installation.
+NOTE:
+ To actually use this package in a useful way, you probably need to
+ move the Emacs Lisp files somewhere. Where will depend on your
+ installation.
+
+ You will also need to install the HTML or Texinfo documentation
+ somewhere appropriate to your system.
EOS
+my %prereq = (
+ 'Data::Dumper' => 0,
+ 'Scalar::Util' => 0,
+);
+
+## Poor man's optional deps.
sub test_for
{
my $mod = shift;
eval "require $mod";
if ($@) {
- print "@_\n";
+ if (-t STDIN) {
+ $| = 1;
+ print "@_. Install $mod [yN]? ";
+ my ($rfd, $wfd, $efd) = ('', '', '');
+ vec($rfd, fileno(STDIN), 1) = 1;
+ if (select $rfd, $wfd, $efd, 60.0) {
+ my $resp = <STDIN>;
+ $prereq{$mod} = 0 if $resp =~ /^y/i;
+ }
+ } else {
+ print "@_\n";
+ }
}
}
-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.';
+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';
+test_for 'Devel::Size', 'Printing variable sizes requires Devel::Size';
+test_for 'Module::Info', 'Module::Info required for some Emacs functions';
+
+WriteMakefile(
+ 'NAME' => 'Sepia',
+ 'VERSION_FROM' => 'lib/Sepia.pm', # finds $VERSION
+ 'PREREQ_PM' => \%prereq,
+ AUTHOR => "Sean O'Rourke <seano\@cpan.org>",
+ ABSTRACT => 'Simple Emacs-Perl InterAction',
+);
diff --git a/README b/README
index f4895cf..81b9205 100644
--- a/README
+++ b/README
@@ -236,18 +236,26 @@ Use completion based on Xref database. Turning this off may speed up
some operations, if you don't mind losing completion.
* TODO
+** implement mod_apropos
+** use xref-completions in sepia-interactive-arg
+** improve output for sepia-module-* (modinfo functions)
+** better intro for debugger
** (Easy) Use module, file, line to refine queries (Perl side)
** (Medium) Get the variable def/use analysis working again.
** (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)
** (Medium) Let sepia-next go backward
- Need to use a ring instead of a list for sepia-found.
+ Need to use a vector plus current index instead of a list for
+ sepia-found.
** (Medium) Use lexical environment more
",eval" should use lexical evaluation whenever PadWalker's available.
** (Hard) return from anything in the debugger
Make it possible to return from intermediate calls in the
debugger. Returning from die() is not often useful.
+** (Easy) Fix sepia-indent-or-complete abbrev expansion
+ Currently "else<TAB>" both expands and completes.
+** (Medium) Clean up Sepia::completions et al.
* BUGS
** Function definition lines may occasionally all go completely wrong.
Rebuilding the Xref database fixes this.
@@ -276,4 +284,5 @@ key components have been stolen and adapted from other packages:
Copyright (C) 2004-2007 by Sean O'Rourke
This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+it under the same terms as Perl itself, at the time at which this
+version of Sepia was released.
diff --git a/Sepia.html b/Sepia.html
index e9af1c0..01d8f25 100644
--- a/Sepia.html
+++ b/Sepia.html
@@ -21,15 +21,39 @@
</head>
<body>
<h1 class="settitle">SEPIA: Simple Emacs Perl Integration</h1>
+<div class="node">
+<p><hr>
<a name="Top"></a>
+Next: <a rel="next" accesskey="n" href="#Introduction">Introduction</a>,
+Previous: <a rel="previous" accesskey="p" href="#dir">(dir)</a>,
+Up: <a rel="up" accesskey="u" href="#dir">(dir)</a>
+
+</div>
<div class="block-image"><img src="Sepia.jpg" alt="Sepia.jpg"></div>
<p>Sepia is a set of Perl development tools for Emacs supporting code
navigation and interactive evaluation.
+<ul class="menu">
+<li><a accesskey="1" href="#Introduction">Introduction</a>
+<li><a accesskey="2" href="#Editing">Editing</a>
+<li><a accesskey="3" href="#Interactive-Perl">Interactive Perl</a>
+<li><a accesskey="4" href="#Customization">Customization</a>
+<li><a accesskey="5" href="#Internals">Internals</a>
+<li><a accesskey="6" href="#Credits">Credits</a>
+<li><a accesskey="7" href="#Function-Index">Function Index</a>
+</ul>
+
<!-- ============================================================ -->
-<p><a name="Introduction"></a>
+<div class="node">
+<p><hr>
+<a name="Introduction"></a>
+Next: <a rel="next" accesskey="n" href="#Editing">Editing</a>,
+Previous: <a rel="previous" accesskey="p" href="#Top">Top</a>,
+Up: <a rel="up" accesskey="u" href="#Top">Top</a>
+
+</div>
<h2 class="chapter">1 Introduction</h2>
@@ -38,7 +62,19 @@ extend CPerl mode to support fast code navigation and interactive
development. It is inspired by Emacs' current support for a number of
other languages, including Lisp, Python, and Emacs Lisp.
-<p><a name="Getting-Started"></a>
+<ul class="menu">
+<li><a accesskey="1" href="#Getting-Started">Getting Started</a>
+<li><a accesskey="2" href="#Philosophy">Philosophy</a>
+</ul>
+
+<div class="node">
+<p><hr>
+<a name="Getting-Started"></a>
+Next: <a rel="next" accesskey="n" href="#Philosophy">Philosophy</a>,
+Previous: <a rel="previous" accesskey="p" href="#Introduction">Introduction</a>,
+Up: <a rel="up" accesskey="u" href="#Introduction">Introduction</a>
+
+</div>
<h3 class="section">1.1 Getting Started</h3>
@@ -55,7 +91,13 @@ other languages, including Lisp, Python, and Emacs Lisp.
</pre>
<p>Then to bring up the interactive Perl prompt, type <kbd>M-x sepia-repl</kbd>.
-<p><a name="Philosophy"></a>
+<div class="node">
+<p><hr>
+<a name="Philosophy"></a>
+Previous: <a rel="previous" accesskey="p" href="#Getting-Started">Getting Started</a>,
+Up: <a rel="up" accesskey="u" href="#Introduction">Introduction</a>
+
+</div>
<h3 class="section">1.2 Philosophy</h3>
@@ -108,7 +150,14 @@ for someone used Perl's typical mix of one-liners and edit-save-run, but
once you are accustomed to it, you may find it very effective.
<!-- ============================================================ -->
-<p><a name="Editing"></a>
+<div class="node">
+<p><hr>
+<a name="Editing"></a>
+Next: <a rel="next" accesskey="n" href="#Interactive-Perl">Interactive Perl</a>,
+Previous: <a rel="previous" accesskey="p" href="#Introduction">Introduction</a>,
+Up: <a rel="up" accesskey="u" href="#Top">Top</a>
+
+</div>
<h2 class="chapter">2 Editing</h2>
@@ -119,7 +168,20 @@ to find function definitions, and to query a cross-reference database of
function and variable uses. Sepia also provides intelligent symbol
completion.
-<p><a name="Completion"></a>
+<ul class="menu">
+<li><a accesskey="1" href="#Completion">Completion</a>
+<li><a accesskey="2" href="#Navigation">Navigation</a>
+<li><a accesskey="3" href="#Documentation">Documentation</a>
+</ul>
+
+<div class="node">
+<p><hr>
+<a name="Completion"></a>
+Next: <a rel="next" accesskey="n" href="#Navigation">Navigation</a>,
+Previous: <a rel="previous" accesskey="p" href="#Editing">Editing</a>,
+Up: <a rel="up" accesskey="u" href="#Editing">Editing</a>
+
+</div>
<h3 class="section">2.1 Completion</h3>
@@ -165,7 +227,14 @@ expanded, then call <code>sepia-complete-symbol</code>.
</dl>
-<p><a name="Navigation"></a>
+<div class="node">
+<p><hr>
+<a name="Navigation"></a>
+Next: <a rel="next" accesskey="n" href="#Documentation">Documentation</a>,
+Previous: <a rel="previous" accesskey="p" href="#Completion">Completion</a>,
+Up: <a rel="up" accesskey="u" href="#Editing">Editing</a>
+
+</div>
<h3 class="section">2.2 Navigation</h3>
@@ -248,7 +317,13 @@ stashes.
</dl>
-<p><a name="Documentation"></a>
+<div class="node">
+<p><hr>
+<a name="Documentation"></a>
+Previous: <a rel="previous" accesskey="p" href="#Navigation">Navigation</a>,
+Up: <a rel="up" accesskey="u" href="#Editing">Editing</a>
+
+</div>
<h3 class="section">2.3 Documentation</h3>
@@ -285,7 +360,14 @@ This is intended to give the programmer a sense of when he is creating
external dependencies.
<!-- ============================================================ -->
-<p><a name="Interactive-Perl"></a>
+<div class="node">
+<p><hr>
+<a name="Interactive-Perl"></a>
+Next: <a rel="next" accesskey="n" href="#Customization">Customization</a>,
+Previous: <a rel="previous" accesskey="p" href="#Editing">Editing</a>,
+Up: <a rel="up" accesskey="u" href="#Top">Top</a>
+
+</div>
<h2 class="chapter">3 Interactive Perl</h2>
@@ -299,7 +381,22 @@ with <code>sepia-complete-symbol</code>.
<p>Sepia also provides a number of other ways to evaluate pieces of code in
Perl, and commands to process buffer text using the inferior process.
-<p><a name="Shortcuts"></a>
+<ul class="menu">
+<li><a accesskey="1" href="#Shortcuts">Shortcuts</a>
+<li><a accesskey="2" href="#Debugger">Debugger</a>
+<li><a accesskey="3" href="#Evaluation">Evaluation</a>
+<li><a accesskey="4" href="#Mutilation">Mutilation</a>
+<li><a accesskey="5" href="#Scratchpad">Scratchpad</a>
+</ul>
+
+<div class="node">
+<p><hr>
+<a name="Shortcuts"></a>
+Next: <a rel="next" accesskey="n" href="#Debugger">Debugger</a>,
+Previous: <a rel="previous" accesskey="p" href="#Interactive-Perl">Interactive Perl</a>,
+Up: <a rel="up" accesskey="u" href="#Interactive-Perl">Interactive Perl</a>
+
+</div>
<h3 class="section">3.1 Shortcuts</h3>
@@ -312,17 +409,29 @@ abbreviated to the shortest unique prefix.
<dl>
<dt><kbd>cd </kbd><var>dir</var><dd>Change Perl's current directory to <var>dir</var>.
+ <br><dt><kbd>debug [</kbd><var>val</var><kbd>]</kbd><dd>Turn Sepia debugger hook on or off, or toggle if <var>val</var> is missing.
+
+ <br><dt><kbd>define </kbd><var>name</var><kbd> ['</kbd><var>doc</var><kbd>'] </kbd><var>body...</var><dd>Define <var>name</var> as a shortcut for Perl code <var>body</var>, with optional
+documentation <var>doc</var>, surrounded by single quotes. <var>body</var> is
+passed the raw command-line text as its first argument.
+
+ <br><dt><kbd>delete</kbd><dd>Delete the current breakpoint.
+
<br><dt><kbd>format </kbd><var>type</var><dd>Set the output format to <var>type</var>, either “dumper” (using
<code>Data::Dumper</code>), “dump” (<code>Data::Dump</code>), “yaml”
(<code>YAML</code>), or “plain” (stringification). Default: “dumper”.
<br><dt><kbd>help</kbd><dd>Display a list of shortcuts.
+ <br><dt><kbd>lsbreak</kbd><dd>List breakpoints.
+
<br><dt><kbd>methods </kbd><var>name</var><kbd> [</kbd><var>regexp</var><kbd>]</kbd><dd>Display a list of functions defined in package <var>name</var> and its
<code>ISA</code>-ancestors matching optional pattern <var>regexp</var>.
<br><dt><kbd>package </kbd><var>name</var><dd>Set the default evaluation package to <var>name</var>.
+ <br><dt><kbd>pwd</kbd><dd>Show the process's current working directory.
+
<br><dt><kbd>quit</kbd><dd>Exit the inferior Perl process.
<br><dt><kbd>reload</kbd><dd>Reload <samp><span class="file">Sepia.pm</span></samp> and recursively invoke the REPL. This command is
@@ -335,21 +444,31 @@ standard error.
given. Note that turning strictness off and on clears the REPL's
lexical environment.
+ <br><dt><kbd>undef </kbd><var>name</var><dd>Undefine shortcut <var>name</var>. <strong>Warning</strong>: this can equally be
+used to remove built-in shortcuts.
+
<br><dt><kbd>wantarray [</kbd><var>val</var><kbd>]</kbd><dd>Set the evaluation context to <var>val</var>, or toggle between scalar and
array context.
- <br><dt><kbd>who [</kbd><var>name</var><kbd> [</kbd><var>regexp</var><kbd>]]</kbd><dd>List identifiers in package <var>name</var> (main by default) matching
-optional pattern <var>regexp</var>.
+ <br><dt><kbd>who </kbd><var>package</var><kbd> [</kbd><var>regexp</var><kbd>]</kbd><dt><kbd>who [</kbd><var>regexp</var><kbd>]</kbd><dd>List identifiers in <var>package</var> (main by default) matching
+optional <var>regexp</var>.
</dl>
-<p><a name="Debugger"></a>
+<div class="node">
+<p><hr>
+<a name="Debugger"></a>
+Next: <a rel="next" accesskey="n" href="#Evaluation">Evaluation</a>,
+Previous: <a rel="previous" accesskey="p" href="#Shortcuts">Shortcuts</a>,
+Up: <a rel="up" accesskey="u" href="#Interactive-Perl">Interactive Perl</a>
+
+</div>
<h3 class="section">3.2 Debugger</h3>
<p>Sepia uses Perl's debugger hooks and GUD mode to support conditional
breakpoints and single-stepping, and overrides Perl's <code>die()</code> to
-invoke the debugger rather than unwinding the stack. This makes it
+invoke the debugger rather than unwind the stack. This makes it
possible to produce a backtrace, inspect and modify global variables,
and even continue execution when a program tries to kill itself. If the
PadWalker module is available, Sepia also provides functions to inspect
@@ -382,7 +501,14 @@ intervention, dying if the debugger was called from <code>die()</code>.
</dl>
-<p><a name="Evaluation"></a>
+<div class="node">
+<p><hr>
+<a name="Evaluation"></a>
+Next: <a rel="next" accesskey="n" href="#Mutilation">Mutilation</a>,
+Previous: <a rel="previous" accesskey="p" href="#Debugger">Debugger</a>,
+Up: <a rel="up" accesskey="u" href="#Interactive-Perl">Interactive Perl</a>
+
+</div>
<h3 class="section">3.3 Evaluation</h3>
@@ -405,7 +531,14 @@ prefix argument, evaluate in list context.
</dl>
-<p><a name="Mutilation"></a>
+<div class="node">
+<p><hr>
+<a name="Mutilation"></a>
+Next: <a rel="next" accesskey="n" href="#Scratchpad">Scratchpad</a>,
+Previous: <a rel="previous" accesskey="p" href="#Evaluation">Evaluation</a>,
+Up: <a rel="up" accesskey="u" href="#Interactive-Perl">Interactive Perl</a>
+
+</div>
<h3 class="section">3.4 Mutilation</h3>
@@ -427,7 +560,13 @@ replace the region.
</dl>
-<p><a name="Scratchpad"></a>
+<div class="node">
+<p><hr>
+<a name="Scratchpad"></a>
+Previous: <a rel="previous" accesskey="p" href="#Mutilation">Mutilation</a>,
+Up: <a rel="up" accesskey="u" href="#Interactive-Perl">Interactive Perl</a>
+
+</div>
<h3 class="section">3.5 Scratchpad</h3>
@@ -438,21 +577,43 @@ like Sepia mode, except <C-j> evaluates the current line and prints
the result on the next line.
<!-- ============================================================ -->
-<p><a name="Customization"></a>
+<div class="node">
+<p><hr>
+<a name="Customization"></a>
+Next: <a rel="next" accesskey="n" href="#Internals">Internals</a>,
+Previous: <a rel="previous" accesskey="p" href="#Interactive-Perl">Interactive Perl</a>,
+Up: <a rel="up" accesskey="u" href="#Top">Top</a>
+
+</div>
<h2 class="chapter">4 Customization</h2>
<p>While Sepia can be customized in both the Perl and Emacs Lisp, most of
-the user-accessible configuration is in the latter. The two variables
-most likely to need customization are <kbd>sepia-program-name</kbd> and
-<kbd>sepia-perl5lib</kbd>. Since Sepia tries where possible to reuse
-existing Emacs functionality, its behavior should already be covered by
-existing customizations.
+the user-accessible configuration is in the latter.
+
+<ul class="menu">
+<li><a accesskey="1" href="#Emacs-Variables">Emacs Variables</a>
+<li><a accesskey="2" href="#Perl-Variables">Perl Variables</a>
+</ul>
-<p><a name="Emacs-Variables"></a>
+<div class="node">
+<p><hr>
+<a name="Emacs-Variables"></a>
+Next: <a rel="next" accesskey="n" href="#Perl-Variables">Perl Variables</a>,
+Previous: <a rel="previous" accesskey="p" href="#Customization">Customization</a>,
+Up: <a rel="up" accesskey="u" href="#Customization">Customization</a>
+
+</div>
<h3 class="section">4.1 Emacs Variables</h3>
+<p>Since Sepia tries where possible to reuse existing Emacs functionality,
+its behavior should already be covered by existing customizations. The
+two variables most likely to need customization are
+<kbd>sepia-program-name</kbd> and <kbd>sepia-perl5lib</kbd>. General Sepia mode
+configuration can be done with <kbd>sepia-mode-hook</kbd>, while
+REPL-specific configuration can be done with <kbd>sepia-repl-mode-hook</kbd>.
+
<dl>
<dt><kbd>sepia-complete-methods</kbd><dd>If non-<code>nil</code>, <code>sepia-complete-symbol</code> will complete
simple method calls of the form <code>$x-></code> or <code>Module-></code>. Since
@@ -493,13 +654,20 @@ slow or undesirable in some situations. Default: <code>T</code>.
Default: <code>sepia-w3m-view-pod</code> if Emacs-w3m is available, or
<code>sepia-perldoc-buffer</code> otherwise.
-</dl>
+ </dl>
+
+<div class="node">
+<p><hr>
+<a name="Perl-Variables"></a>
+Previous: <a rel="previous" accesskey="p" href="#Emacs-Variables">Emacs Variables</a>,
+Up: <a rel="up" accesskey="u" href="#Customization">Customization</a>
-<p><a name="Perl-Variables"></a>
+</div>
<h3 class="section">4.2 Perl Variables</h3>
-<p>The following variables in the Sepia package control various aspects of
+<p>When Sepia starts up, it evaluates the Perl script in <samp><span class="file">~/.sepiarc</span></samp>.
+The following variables in the Sepia package control various aspects of
interactive evaluation.
<dl>
@@ -526,8 +694,24 @@ Sepia debugger. Default: false.
</dl>
+ <p>Additional REPL shortcuts can be defined with
+<kbd>Sepia::define_shortcut</kbd>. For example
+
+<pre class="example"> Sepia::define_shortcut time => sub { print scalar localtime, "\n"; 0 },
+ 'Display the current time.';
+</pre>
+ <p>defines a shortcut “time” that displays the current time. For
+details, see the code in <samp><span class="file">Sepia.pm</span></samp>.
+
<!-- ============================================================ -->
-<p><a name="Internals"></a>
+<div class="node">
+<p><hr>
+<a name="Internals"></a>
+Next: <a rel="next" accesskey="n" href="#Credits">Credits</a>,
+Previous: <a rel="previous" accesskey="p" href="#Customization">Customization</a>,
+Up: <a rel="up" accesskey="u" href="#Top">Top</a>
+
+</div>
<h2 class="chapter">5 Internals</h2>
@@ -536,18 +720,35 @@ details mentioned above should probably be given less prominence. For
developer documentation, please see the POD for <code>Sepia</code> and
<code>Sepia::Xref</code>, and the doc-strings in <samp><span class="file">sepia.el</span></samp>.
-<p><a name="Credits"></a>
+<div class="node">
+<p><hr>
+<a name="Credits"></a>
+Next: <a rel="next" accesskey="n" href="#Function-Index">Function Index</a>,
+Previous: <a rel="previous" accesskey="p" href="#Internals">Internals</a>,
+Up: <a rel="up" accesskey="u" href="#Top">Top</a>
+
+</div>
<h2 class="unnumbered">Credits</h2>
-<p>I would like to thank Hilko Bengen for finding and motivating me to fix
-a bunch of bugs, and for doing the Debian packaging.
+ <dl>
+<dt>Hilko Bengen<dd>Found and motivated me to fix a bunch of bugs, created Debian packages.
+
+ <br><dt>Ye Wenbin<dd>Found and fixed numerous bugs.
- <p>I would also like to thank the authors of Emacs-w3m, SLIME, ido, and
-B::Xref for the code I stole.
+ <br><dt>Free Software<dd>Portions of the code were lifted from Emacs-w3m, SLIME, ido, and
+B::Xref, all of which are Free software.
+
+</dl>
<!-- ============================================================ -->
-<p><a name="Function-Index"></a>
+<div class="node">
+<p><hr>
+<a name="Function-Index"></a>
+Previous: <a rel="previous" accesskey="p" href="#Credits">Credits</a>,
+Up: <a rel="up" accesskey="u" href="#Top">Top</a>
+
+</div>
<h2 class="unnumbered">Function Index</h2>
diff --git a/debian/changelog b/debian/changelog
index 649f59f..e433935 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+sepia (0.96-1) unstable; urgency=low
+
+ * New upstream version
+
+ -- Hilko Bengen <bengen at debian.org> Wed, 19 Dec 2007 15:23:24 +0100
+
sepia (0.92-2) unstable; urgency=low
* Fixed build-dependency: s/makeinfo/texinfo/ (Closes: #433741)
diff --git a/debian/control b/debian/control
index fa03c1b..4dd0f54 100644
--- a/debian/control
+++ b/debian/control
@@ -4,7 +4,7 @@ Priority: optional
Build-Depends: debhelper (>= 5.0.0)
Build-Depends-Indep: texinfo, perl (>= 5.8.8-7), libpadwalker-perl (>= 1.0), libmodule-info-perl, libsub-uplevel-perl
Maintainer: Hilko Bengen <bengen at debian.org>
-Standards-Version: 3.7.2
+Standards-Version: 3.7.3
Package: sepia
Architecture: all
diff --git a/lib/._Sepia.pm b/lib/._Sepia.pm
deleted file mode 100644
index 45df49c..0000000
Binary files a/lib/._Sepia.pm and /dev/null differ
diff --git a/lib/Sepia.pm b/lib/Sepia.pm
index ac0bb91..6554d6f 100644
--- a/lib/Sepia.pm
+++ b/lib/Sepia.pm
@@ -15,31 +15,29 @@ At the prompt in the C<*sepia-repl*> buffer:
main @> ,help
-For more information, please see F<sepia/index.html>.
+For more information, please see F<Sepia.html> or F<sepia.info>, which
+come with the distribution.
=cut
-$VERSION = '0.92';
+$VERSION = '0.96';
use strict;
use B;
use Sepia::Debug; # THIS TURNS ON DEBUGGING INFORMATION!
use Cwd 'abs_path';
use Scalar::Util 'looks_like_number';
-use Module::Info;
use Text::Abbrev;
-use vars qw($PS1 %REPL %RK %REPL_DOC
- $REPL_LEVEL $REPL_IN $REPL_OUT
- $PACKAGE $WANTARRAY $PRINTER $STRICT $PRINT_PRETTY
+use vars qw($PS1 %REPL %RK %REPL_DOC %REPL_SHORT %PRINTER
+ @REPL_RESULT
+ $REPL_LEVEL $PACKAGE $WANTARRAY $PRINTER $STRICT $PRINT_PRETTY
$ISEVAL);
-BEGIN {
+sub repl_strict
+{
eval { require Lexical::Persistence; import Lexical::Persistence };
if ($@) {
- *repl_strict = sub {
- print STDERR "Strict mode requires Lexical::Persistence.\n";
- 0;
- };
+ print "Strict mode requires Lexical::Persistence.\n";
} else {
*repl_strict = sub {
my $x = as_boolean(shift, $STRICT);
@@ -48,14 +46,64 @@ BEGIN {
} elsif (!$x) {
undef $STRICT;
}
- 0;
};
+ goto &repl_strict;
}
+}
+
+sub core_version
+{
eval { require Module::CoreList };
if ($@) {
- *Sepia::core_version = sub { '???' };
+ '???';
+ } else {
+ *core_version = sub { Module::CoreList->first_release(@_) };
+ goto &core_version;
+ }
+}
+
+BEGIN {
+ eval { use List::Util 'max' };
+ if ($@) {
+ *Sepia::max = sub {
+ my $ret = shift;
+ for (@_) {
+ $ret = $_ if $_ > $ret;
+ }
+ $ret;
+ };
+ }
+}
+
+sub repl_size
+{
+ eval { require Devel::Size };
+ if ($@) {
+ print "Size requires Devel::Size.\n";
} else {
- *Sepia::core_version = sub { Module::CoreList->first_release(@_) };
+ *Sepia::repl_size = sub {
+ ## XXX: C&P from repl_who:
+ my ($pkg, $re) = split ' ', shift || '';
+ if ($pkg =~ /^\/(.*)\/?$/) {
+ $pkg = $PACKAGE;
+ $re = $1;
+ } elsif (!$re && !defined %{$pkg.'::'}) {
+ $re = $pkg;
+ $pkg = $PACKAGE;
+ }
+ my @who = who($pkg, $re);
+ my $len = max(map { length } @who) + 4;
+ my $fmt = '%-'.$len."s%10d\n";
+ print 'Var', ' ' x ($len + 2), "Bytes\n";
+ print '-' x ($len-4), ' ' x 9, '-' x 5, "\n";
+ local $SIG{__WARN__} = sub {};
+ for (@who) {
+ my $res = eval "package $pkg; Devel::Size::total_size \\$_;";
+ next if $res == 0;
+ printf $fmt, $_, $res || 0;
+ }
+ };
+ goto &repl_size;
}
}
@@ -109,99 +157,111 @@ sub _apropos_re($)
}
}
-sub _completions1
-{
- no strict;
- my $stash = shift;
- my $re = shift || '';
- $re = qr/$re/;
- if (@_ == 0 || !defined $_[0]) {
- map "$stash$_", grep /$re/, keys %$stash;
- } else {
- map {
- _completions1("$stash$_", @_);
- } grep /$re.*::$/, keys %$stash;
- };
-}
-
-sub _completions
-{
- _completions1 '::', _apropos_re($_[0]);
-}
-
my %sigil;
BEGIN {
%sigil = qw(ARRAY @ SCALAR $ HASH %);
}
-## XXX: autovivification gives us problems here sometimes. Specifically:
+sub filter_untyped
+{
+ no strict;
+ local $_ = /^::/ ? $_ : "::$_";
+ defined *{$_}{CODE} || defined *{$_}{IO} || (/::$/ && defined *{$_}{HASH});
+}
+
+## XXX: Careful about autovivification here! Specifically:
## defined *FOO{HASH} # => ''
## defined %FOO # => ''
## defined *FOO{HASH} # => 1
-sub completions
+sub filter_typed
{
no strict;
- my ($str, $type, $infunc) = @_;
- my @ret;
-
- if (!$type) {
- @ret = grep {
- defined *{$_}{CODE} || defined *{$_}{IO}
- || (/::$/ && defined *{$_}{HASH});
- } _completions $str;
+ my $type = shift;
+ local $_ = /^::/ ? $_ : "::$_";
+ if ($type eq 'SCALAR') {
+ defined ${$_};
+ } elsif ($type eq 'VARIABLE') {
+ defined ${$_} || defined *{$_}{HASH} || defined *{$_}{ARRAY};
} else {
- @ret = grep {
- 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);
- my $st = $sigil{$type};
- push @ret, grep {
- (my $tmp = $_) =~ s/^\Q$st//;
- $tmp =~ /$apre/;
- } lexicals($infunc);
- }
+ defined *{$_}{$type}
}
+}
+
+sub maybe_icase
+{
+ my $ch = shift;
+ $ch =~ /[A-Z]/ ? $ch : '['.uc($ch).$ch.']';
+}
- ## Complete "simple" sequences as abbreviations, e.g.:
- ## wtci -> Want_To_Complete_It, NOT
- ## -> WaTCh_trIpe
- if (!@ret && $str !~ /[^\w\d]/) {
- my $broad = join '.*', map "\\b$_", split '', $str;
- if ($type) {
- @ret = grep {
- defined *{$_}{CODE} || defined *{$_}{IO}
- || (/::$/ && defined *{$_}{HASH});
- } _completions1 '::', qr/$broad/;
+sub all_abbrev_completions
+{
+ use vars '&_completions';
+ local *_completions = sub {
+ no strict;
+ my ($stash, @e) = @_;
+ my $ch = '[A-Za-z0-9]*';
+ my $re1 = "^".maybe_icase($e[0]).$ch.join('', map {
+ '_'.maybe_icase($_).$ch
+ } @e[1..$#e]);
+ $re1 = qr/$re1/;
+ my $re2 = maybe_icase $e[0];
+ $re2 = qr/^$re2.*::$/;
+ my @ret = grep !/::$/ && /$re1/, keys %{$stash};
+ my @pkgs = grep /$re2/, keys %{$stash};
+ (map("$stash$_", @ret),
+ @e > 1 ? map { _completions "$stash$_", @e[1..$#e] } @pkgs :
+ map { "$stash$_" } @pkgs)
+ };
+ map { s/^:://; $_ } _completions('::', split //, shift);
+}
+
+sub apropos_re
+{
+ my ($icase, $re) = @_;
+ $re =~ s/_/[^_]*_/g;
+ $icase ? qr/^$re.*$/i : qr/^$re.*$/;
+}
+
+sub all_completions
+{
+ my $icase = $_[0] !~ /[A-Z]/;
+ my @parts = split /:+/, shift, -1;
+ my $re = apropos_re $icase, pop @parts;
+ use vars '&_completions';
+ local *_completions = sub {
+ no strict;
+ my $stash = shift;
+ if (@_ == 0) {
+ map { "$stash$_" } grep /$re/, keys %{$stash};
} else {
- @ret = grep {
- $type eq 'SCALAR' ? defined ${$_} : defined *{$_}{$type}
- } _completions1 '::', qr/$broad/;
+ my $re2 = $icase ? qr/^$_[0].*::$/i : qr/^$_[0].*::$/;
+ my @pkgs = grep /$re2/, keys %{$stash};
+ map { _completions "$stash$_", @_[1..$#_] } @pkgs
}
- if (defined $infunc && defined *{$infunc}{CODE}) {
- my $st = $sigil{$type};
- grep {
- (my $tmp = $_) =~ s/^\Q$st//;
- $tmp =~ /$broad/;
- } lexicals($infunc);
- }
- }
- ## Complete packages so e.g. "new B:T" -> "new Blah::Thing"
- ## instead of "new Blah::Thing::"
- if (!$type) {
- @ret = map { /(.*)::$/ ? ($1, $_) : $_ } @ret;
+ };
+ map { s/^:://; $_ } _completions('::', @parts);
+}
+
+sub completions
+{
+ my ($type, $str) = $_[0] =~ /^([\%\$\@\&]?)(.*)/;
+ my %h = qw(@ ARRAY % HASH & CODE * IO $ SCALAR);
+ my $t = $type || '';
+ $type = $h{$type} if $type;
+ my @ret = grep {
+ $type ? filter_typed $type : filter_untyped
+ } all_completions $str;
+ if (!@ret && $str !~ /:/) {
+ @ret = grep {
+ $type ? filter_typed $type : filter_untyped
+ } all_abbrev_completions $str;
}
- ## XXX: Control characters, $", and $1, etc. confuse Emacs, so
- ## remove them.
+ @ret = map { s/^:://; "$t$_" } @ret;
+# ## XXX: Control characters, $", and $1, etc. confuse Emacs, so
+# ## remove them.
grep {
length > 0 && !looks_like_number $_ && !/^[^\w\d_]$/ && !/^_</ && !/^[[:cntrl:]]/
- } map { s/^:://; $_ } @ret;
+ } @ret;
}
sub method_completions
@@ -370,23 +430,31 @@ Emacs-called function to get module information.
=cut
-sub module_info($$)
+sub module_info
{
- my ($m, $func) = @_;
- my $info;
- if (-f $m) {
- $info = Module::Info->new_from_file($m);
+ eval { require Module::Info; import Module::Info };
+ if ($@) {
+ undef;
} else {
- (my $file = $m) =~ s|::|/|g;
- $file .= '.pm';
- if (exists $INC{$file}) {
- $info = Module::Info->new_from_loaded($m);
- } else {
- $info = Module::Info->new_from_module($m);
- }
- }
- if ($info) {
- return $info->$func;
+ *module_info = sub {
+ my ($m, $func) = @_;
+ my $info;
+ if (-f $m) {
+ $info = Module::Info->new_from_file($m);
+ } else {
+ (my $file = $m) =~ s|::|/|g;
+ $file .= '.pm';
+ if (exists $INC{$file}) {
+ $info = Module::Info->new_from_loaded($m);
+ } else {
+ $info = Module::Info->new_from_module($m);
+ }
+ }
+ if ($info) {
+ return $info->$func;
+ }
+ };
+ goto &module_info;
}
}
@@ -529,59 +597,54 @@ which can use either L<Data::Dumper>, L<YAML>, or L<Data::Dump>.
=cut
-sub print_dumper
-{
- eval { require Data::Dumper };
- local $Data::Dumper::Deparse = 1;
- local $Data::Dumper::Indent = 0;
- local $_;
- no strict;
- my $thing = @res > 1 ? \@res : $res[0];
- eval {
- $_ = Data::Dumper::Dumper($thing);
- s/^\$VAR1 = //;
- s/;$//;
- };
- if (length $_ > ($ENV{COLUMNS} || 80)) {
- $Data::Dumper::Indent = 2;
+%PRINTER = (
+ dumper => sub {
+ eval { require Data::Dumper };
+ local $Data::Dumper::Deparse = 1;
+ local $Data::Dumper::Indent = 0;
+ local $_;
+ no strict;
+ my $thing = @res > 1 ? \@res : $res[0];
eval {
$_ = Data::Dumper::Dumper($thing);
+ s/^\$VAR1 = //;
+ s/;$//;
+ };
+ if (length $_ > ($ENV{COLUMNS} || 80)) {
+ $Data::Dumper::Indent = 1;
+ eval {
+ $_ = Data::Dumper::Dumper($thing);
+ s/\A\$VAR1 = //;
+ s/;\Z//;
+ };
s/\A\$VAR1 = //;
s/;\Z//;
- };
- s/\A\$VAR1 = //;
- s/;\Z//;
- }
- $_;
-}
-
-sub print_plain
-{
- no strict;
- "@res";
-}
-
-sub print_yaml
-{
- no strict;
- eval { require YAML };
- if ($@) {
- print_dumper;
- } else {
- YAML::Dump(\@res);
- }
-}
-
-sub print_dump
-{
- no strict;
- eval { require Data::Dump };
- if ($@) {
- print_dumper;
- } else {
- Data::Dump::dump(\@res);
+ }
+ $_;
+ },
+ plain => sub {
+ no strict;
+ "@res";
+ },
+ yaml => sub {
+ no strict;
+ eval { require YAML };
+ if ($@) {
+ $PRINTER{dumper}->();
+ } else {
+ YAML::Dump(\@res);
+ }
+ },
+ dump => sub {
+ no strict;
+ eval { require Data::Dump };
+ if ($@) {
+ $PRINTER{dumper}->();
+ } else {
+ Data::Dump::dump(\@res);
+ }
}
-}
+);
sub printer
{
@@ -597,108 +660,26 @@ sub printer
# overloaded?
$res = $res[0];
} elsif (!$ISEVAL && $PRINT_PRETTY && @res > 1 && !grep ref, @res) {
- $res = columnate(sort @res);
+ $res = columnate(@res);
print $res;
return;
} else {
- $res = $PRINTER->();
+ $res = $PRINTER{$PRINTER}->();
}
if ($ISEVAL) {
print ';;;', length $res, "\n$res\n";
} else {
- print "=> $res\n";
+ print "$res\n";
}
}
-=head2 C<repl(\*FH)>
-
-Execute a command interpreter on FH. The prompt has a few bells and
-whistles, including:
-
- * Obviously-incomplete lines are treated as multiline input (press
- 'return' twice or 'C-c' to discard).
-
- * C<die> is overridden to enter a recursive interpreter at the point
- C<die> is called. From within this interpreter, you can examine a
- backtrace by calling "bt", return from C<die> with "r EXPR", or
- go ahead and die by pressing Control-c.
-
-Behavior is controlled in part through the following package-globals:
-
-=over 4
-
-=item C<$PACKAGE> -- evaluation package
-
-=item C<$PRINTER> -- result printer (default: print_dumper)
-
-=item C<$PS1> -- the default prompt
-
-=item C<$STRICT> -- whether 'use strict' is applied to input
-
-=item C<$WANTARRAY> -- evaluation context
-
-=item C<$PRINT_PRETTY> -- format some output nicely (default = 1)
-
-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
-
-=back
-
-=cut
-
BEGIN {
no strict;
$PS1 = "> ";
$PACKAGE = 'main';
$WANTARRAY = 1;
- $PRINTER = \&Sepia::print_dumper;
+ $PRINTER = 'dumper';
$PRINT_PRETTY = 1;
- %REPL = (help => \&Sepia::repl_help,
- cd => \&Sepia::repl_chdir,
- methods => \&Sepia::repl_methods,
- package => \&Sepia::repl_package,
- who => \&Sepia::repl_who,
- wantarray => \&Sepia::repl_wantarray,
- format => \&Sepia::repl_format,
- strict => \&Sepia::repl_strict,
- quit => \&Sepia::repl_quit,
- reload => \&Sepia::repl_reload,
- shell => \&Sepia::repl_shell,
- eval => \&Sepia::repl_eval,
- );
- %REPL_DOC = (
- cd =>
- 'cd DIR Change directory to DIR',
- format =>
- 'format [dumper|dump|yaml|plain]
- Set output formatter (default: dumper)',
- help =>
- 'help Display this message',
- 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 =>
- 'quit Quit the REPL',
- shell =>
- 'shell CMD ... Run CMD in the shell.',
- strict =>
- 'strict [0|1] Turn \'use strict\' mode on or off',
- wantarray =>
- 'wantarray [0|1] Set or toggle evaluation context',
- who => <<EOS,
-who PACKAGE [RE] List variables and subs in PACKAGE matching optional
- pattern RE.
-EOS
- reload =>
- 'reload Reload Sepia.pm and relaunch the REPL.',
- );
}
sub prompt()
@@ -706,35 +687,164 @@ sub prompt()
"$PACKAGE ".($WANTARRAY ? '@' : '$').$PS1
}
-sub Dump {
+sub Dump
+{
eval {
Data::Dumper->Dump([$_[0]], [$_[1]]);
};
}
+sub flow
+{
+ my $n = shift;
+ my $n1 = int($n/2);
+ local $_ = shift;
+ s/(.{$n1,$n}) /$1\n/g;
+ $_
+}
+
+=head2 C<define_shortcut $name, $sub [, $doc [, $shortdoc]]>
+
+Define $name as a shortcut for function $sub.
+
+=cut
+
+ sub define_shortcut
+{
+ my ($name, $doc, $short, $fn);
+ if (@_ == 2) {
+ ($name, $fn) = @_;
+ $short = $name;
+ $doc = '';
+ } elsif (@_ == 3) {
+ ($name, $fn, $doc) = @_;
+ $short = $name;
+ } else {
+ ($name, $fn, $short, $doc) = @_;
+ }
+ $REPL{$name} = $fn;
+ $REPL_DOC{$name} = $doc;
+ $REPL_SHORT{$name} = $short;
+}
+
+sub define_shortcuts
+{
+ define_shortcut 'help', \&Sepia::repl_help,
+ 'help [CMD]',
+ 'Display help on all commands, or just CMD.';
+ define_shortcut 'cd', \&Sepia::repl_chdir,
+ 'cd DIR', 'Change directory to DIR';
+ define_shortcut 'pwd', \&Sepia::repl_pwd,
+ 'Show current working directory';
+ define_shortcut 'methods', \&Sepia::repl_methods,
+ 'methods X [RE]',
+ 'List methods for reference or package X, matching optional pattern RE';
+ define_shortcut 'package', \&Sepia::repl_package,
+ 'package PKG', 'Set evaluation package to PKG';
+ define_shortcut 'who', \&Sepia::repl_who,
+ 'who PKG [RE]',
+ 'List variables and subs in PKG matching optional pattern RE.';
+ define_shortcut 'wantarray', \&Sepia::repl_wantarray,
+ 'wantarray [0|1]', 'Set or toggle evaluation context';
+ define_shortcut 'format', \&Sepia::repl_format,
+ 'format [TYPE]', "Set output formatter to TYPE (one of 'dumper', 'dump', 'yaml', 'plain'; default: 'dumper'), or show current type.";
+ define_shortcut 'strict', \&Sepia::repl_strict,
+ 'strict [0|1]', 'Turn \'use strict\' mode on or off';
+ define_shortcut 'quit', \&Sepia::repl_quit,
+ 'Quit the REPL';
+ define_shortcut 'reload', \&Sepia::repl_reload,
+ 'Reload Sepia.pm and relaunch the REPL.';
+ define_shortcut 'shell', \&Sepia::repl_shell,
+ 'shell CMD ...', 'Run CMD in the shell';
+ define_shortcut 'eval', \&Sepia::repl_eval,
+ 'eval EXP', '(internal)';
+ define_shortcut 'size', \&Sepia::repl_size,
+ 'size PKG [RE]',
+ 'List total sizes of objects in PKG matching optional pattern RE.';
+ define_shortcut define => \&Sepia::repl_define,
+ 'define NAME [\'doc\'] BODY',
+ 'Define NAME as a shortcut executing BODY';
+ define_shortcut undef => \&Sepia::repl_undef,
+ 'undef NAME', 'Undefine shortcut NAME';
+}
+
sub repl_help
{
- print "REPL commands (prefixed with ','):\n";
- for (sort keys %REPL) {
- print " ", exists $REPL_DOC{$_} ? "$REPL_DOC{$_}\n":
- sprintf("%-18s (undocumented)\n", $_);
+ my $width = $ENV{COLUMNS} || 80;
+ my $args = shift;
+ if ($args =~ /\S/) {
+ $args =~ s/^\s+//;
+ $args =~ s/\s+$//;
+ my $full = $RK{$args};
+ if ($full) {
+ print "$RK{$full} ",
+ flow($width - length $RK{$full} - 4, $REPL_DOC{$full}), "\n";
+ } else {
+ print "$args: no such command\n";
+ }
+ } else {
+ my $left = 1 + max map length, values %REPL_SHORT;
+ print "REPL commands (prefixed with ','):\n";
+
+ for (sort keys %REPL) {
+ my $flow = flow($width - $left, $REPL_DOC{$_});
+ $flow =~ s/(.)\n/"$1\n".(' ' x $left)/eg;
+ printf "%-${left}s%s\n", $REPL_SHORT{$_}, $flow;
+ }
+ }
+}
+
+sub repl_define
+{
+ local $_ = shift;
+ my ($name, $doc, $body);
+ if (/^\s*(\S+)\s+'((?:[^'\\]|\\.)*)'\s+(.+)/) {
+ ($name, $doc, $body) = ($1, $2, $3);
+ } elsif (/^\s*(\S+)\s+(\S.*)/) {
+ ($name, $doc, $body) = ($1, $2, $2);
+ } else {
+ print "usage: define NAME ['doc'] BODY...\n";
+ return;
+ }
+ my $sub = eval "sub { do { $body } }";
+ if ($@) {
+ print "usage: define NAME ['doc'] BODY...\n\t$@\n";
+ return;
+ }
+ define_shortcut $name, $sub, $doc;
+ %RK = abbrev keys %REPL;
+}
+
+sub repl_undef
+{
+ my $name = shift;
+ $name =~ s/^\s*//;
+ $name =~ s/\s*$//;
+ my $full = $RK{$name};
+ if ($full) {
+ delete $REPL{$full};
+ delete $REPL_SHORT{$full};
+ delete $REPL_DOC{$full};
+ %RK = abbrev keys %REPL;
+ } else {
+ print "$name: no such shortcut.\n";
}
- 0;
}
sub repl_format
{
my $t = shift;
chomp $t;
- $t = 'dumper' if $t eq '';
- my %formats = abbrev qw(dumper dump yaml plain);
- if (exists $formats{$t}) {
- no strict;
- $PRINTER = \&{'print_'.$formats{$t}};
+ if ($t eq '') {
+ print "printer = $PRINTER, pretty = @{[$PRINT_PRETTY ? 1 : 0]}\n";
} else {
- warn "No such format '$t' (dumper, dump, yaml, plain).\n";
+ my %formats = abbrev keys %PRINTER;
+ if (exists $formats{$t}) {
+ $PRINTER = $formats{$t};
+ } else {
+ warn "No such format '$t' (dumper, dump, yaml, plain).\n";
+ }
}
- 0;
}
sub repl_chdir
@@ -743,14 +853,17 @@ sub repl_chdir
$dir =~ s/^~\//$ENV{HOME}\//;
$dir =~ s/\$HOME/$ENV{HOME}/;
if (-d $dir) {
-
chdir $dir;
my $ecmd = '(cd "'.Cwd::getcwd().'")';
print ";;;###".length($ecmd)."\n$ecmd\n";
} else {
warn "Can't chdir\n";
}
- 0;
+}
+
+sub repl_pwd
+{
+ print Cwd::getcwd(), "\n";
}
sub who
@@ -791,8 +904,14 @@ sub columnate
sub repl_who
{
my ($pkg, $re) = split ' ', shift;
+ if ($pkg =~ /^\/(.*)\/?$/) {
+ $pkg = $PACKAGE;
+ $re = $1;
+ } elsif (!$re && !defined %{$pkg.'::'}) {
+ $re = $pkg;
+ $pkg = $PACKAGE;
+ }
print columnate who($pkg || $PACKAGE, $re);
- 0;
}
sub methods
@@ -821,7 +940,6 @@ sub repl_methods
$re ||= '.?';
$re = qr/$re/;
print columnate sort { $a cmp $b } grep /$re/, methods $x;
- 0;
}
sub as_boolean
@@ -834,7 +952,6 @@ sub as_boolean
sub repl_wantarray
{
$WANTARRAY = as_boolean shift, $WANTARRAY;
- 0;
}
sub repl_package
@@ -848,12 +965,11 @@ sub repl_package
} else {
warn "Can't go to package $p -- doesn't exist!\n";
}
- 0;
}
sub repl_quit
{
- 1;
+ last repl;
}
sub repl_reload
@@ -862,7 +978,7 @@ sub repl_reload
if ($@) {
print "Reload failed:\n$@\n";
} else {
- @_ = (select, 0);
+ $REPL_LEVEL = 0; # ok?
goto &Sepia::repl;
}
}
@@ -871,7 +987,6 @@ sub repl_shell
{
my $cmd = shift;
print `$cmd 2>& 1`;
- return 0;
}
sub repl_eval
@@ -924,15 +1039,68 @@ sub print_warnings
}
}
+sub repl_banner
+{
+ print <<EOS;
+I need user feedback! Please send questions or comments to seano\@cpan.org.
+Sepia version $Sepia::VERSION.
+Type ",h" for help, or ",q" to quit.
+EOS
+}
+
+=head2 C<repl()>
+
+Execute a command interpreter on standard input and standard output.
+If you want to use different descriptors, localize them before
+calling C<repl()>. The prompt has a few bells and whistles, including:
+
+ * Obviously-incomplete lines are treated as multiline input (press
+ 'return' twice or 'C-c' to discard).
+
+ * C<die> is overridden to enter a debugging repl at the point
+ C<die> is called.
+
+Behavior is controlled in part through the following package-globals:
+
+=over 4
+
+=item C<$PACKAGE> -- evaluation package
+
+=item C<$PRINTER> -- result printer (default: dumper)
+
+=item C<$PS1> -- the default prompt
+
+=item C<$STRICT> -- whether 'use strict' is applied to input
+
+=item C<$WANTARRAY> -- evaluation context
+
+=item C<$PRINT_PRETTY> -- format some output nicely (default = 1)
+
+Format some values nicely, independent of $PRINTER. Currently, this
+displays arrays of scalars as columns.
+
+=item C<$REPL_LEVEL> -- level of recursive repl() calls
+
+If zero, then initialization takes place.
+
+=item C<%REPL> -- maps shortcut names to handlers
+
+=item C<%REPL_DOC> -- maps shortcut names to documentation
+
+=item C<%REPL_SHORT> -- maps shortcut names to brief usage
+
+=back
+
+=cut
+
sub repl
{
- if (@_ > 0) {
- $REPL_IN = $_[0];
- $REPL_OUT = $_[1];
- }
- select $REPL_OUT;
$| = 1;
-
+ if ($REPL_LEVEL == 0) {
+ define_shortcuts;
+ -f "$ENV{HOME}/.sepiarc" and do "$ENV{HOME}/.sepiarc";
+ warn ".sepiarc: $@\n" if $@;
+ }
local $REPL_LEVEL = $REPL_LEVEL + 1;
my $in;
@@ -944,16 +1112,14 @@ sub repl
local *__;
local *CORE::GLOBAL::die = \&Sepia::Debug::die;
local *CORE::GLOBAL::warn = \&Sepia::Debug::warn;
+ local @REPL_RESULT;
Sepia::Debug::add_repl_commands;
- print <<EOS if $REPL_LEVEL == 1;
-Sepia version $Sepia::VERSION.
-Press ",h" for help, or "^D" or ",q" to exit.
-EOS
+ repl_banner if $REPL_LEVEL == 1;
print prompt;
my @sigs = qw(INT TERM PIPE ALRM);
local @SIG{@sigs};
$SIG{$_} = $nextrepl for @sigs;
- repl: while (defined(my $in = <$REPL_IN>)) {
+ repl: while (defined(my $in = <STDIN>)) {
if ($sigged) {
$buf = '';
$sigged = 0;
@@ -968,7 +1134,7 @@ EOS
my $len = $1;
my $tmp;
$buf = $2;
- while ($len && defined($tmp = read $REPL_IN, $buf, $len, length $buf)) {
+ while ($len && defined($tmp = read STDIN, $buf, $len, length $buf)) {
$len -= $tmp;
}
}
@@ -986,10 +1152,7 @@ EOS
my $ret;
my $arg = $2;
chomp $arg;
- ($ret, @res) = $Sepia::REPL{$Sepia::RK{$short}}->($arg, wantarray);
- if ($ret) {
- return wantarray ? @res : $res[0];
- }
+ $Sepia::REPL{$Sepia::RK{$short}}->($arg, wantarray);
} else {
if (grep /^$short/, keys %Sepia::REPL) {
print "Ambiguous shortcut '$short': ",
@@ -1013,7 +1176,7 @@ EOS
# print_warnings $ISEVAL;
$buf = '';
print prompt;
- } elsif ($@ =~ /at EOF$/m) {
+ } elsif ($@ =~ /(?:at|before) EOF(?:$| at)/m) {
## Possibly-incomplete line
if ($in eq "\n") {
print "Error:\n$@\n*** cancel ***\n", prompt;
@@ -1031,7 +1194,7 @@ EOS
next repl;
}
}
- if ($buf !~ /;$/ && $buf !~ /^,/) {
+ if ($buf !~ /;\s*$/ && $buf !~ /^,/) {
## Be quiet if it ends with a semicolon, or if we
## executed a shortcut.
Sepia::printer \@res, wantarray;
@@ -1040,6 +1203,7 @@ EOS
print_warnings;
print prompt;
}
+ wantarray ? @REPL_RESULT : $REPL_RESULT[0]
}
sub perl_eval
diff --git a/lib/Sepia/Debug.pm b/lib/Sepia/Debug.pm
index fb67720..d0aafdb 100644
--- a/lib/Sepia/Debug.pm
+++ b/lib/Sepia/Debug.pm
@@ -1,11 +1,14 @@
package Sepia::Debug;
# use Sepia;
-require Carp;
+use Carp (); # old Carp doesn't export shortmess.
use Text::Abbrev;
use strict;
use vars qw($pack $file $line $sub $level
$STOPDIE $STOPWARN);
+sub define_shortcut;
+*define_shortcut = *Sepia::define_shortcut;
+
BEGIN {
## Just leave it on -- with $DB::trace = 0, there doesn't seem
## to be a perforamnce penalty!
@@ -23,7 +26,6 @@ BEGIN {
sub repl_debug
{
debug(@_);
- 0;
}
sub repl_backtrace
@@ -33,13 +35,17 @@ sub repl_backtrace
last unless $pack;
print($i == $level+3 ? "*" : ' ', " [$i]\t$sub ($file:$line)\n");
}
- 0
}
# return value from die
sub repl_return
{
- (1, $Sepia::REPL{eval}->(@_));
+ if ($Sepia::WANTARRAY) {
+ @Sepia::REPL_RESULT = $Sepia::REPL{eval}->(@_);
+ } else {
+ $Sepia::REPL_RESULT[0] = $Sepia::REPL{eval}->(@_);
+ }
+ last repl;
}
sub repl_lsbreak
@@ -78,35 +84,6 @@ sub tie_class
: die "Sorry, can't tie $sig\n";
}
-# {
-# require Tie::Array;
-# require Tie::Hash;
-# require Tie::Scalar;
-# package Sepia::Array;
-# our @ISA = qw(Tie::StdArray);
-# sub TIEARRAY { bless $_[1], $_[0] }
-# package Sepia::Hash;
-# our @ISA = qw(Tie::StdHash);
-# sub TIEHASH { bless $_[1], $_[0] }
-# package Sepia::Scalar;
-# our @ISA = qw(Tie::StdScalar);
-# sub TIESCALAR { bless $_[1], $_[0] }
-# }
-
-# sub eval_in_env3
-# {
-# my ($expr, $env) = @_;
-# my @vars = grep /^([\$\@%])(.+)/, keys %$env;
-# my $body = 'sub { my ('.join(',', @vars).');';
-# for my $i (0..$#vars) {
-# $body .= "tie $vars[$i], ".tie_class($vars[$i]).', $_['.$i.'];';
-# }
-# $body .= "$expr }";
-# print STDERR "---\n$body\n---\n";
-# $body = eval $body;
-# $@ || $body->(@{$env}{@vars});
-# }
-
## XXX: this is a better approach (the local/tie business is vile),
## but it segfaults and I'm not sure why.
sub eval_in_env2
@@ -127,12 +104,7 @@ sub eval_in_env2
# evaluate EXP LEV levels up the stack
sub repl_upeval
{
- my $exp = shift;
- # my ($lev, $exp) = $_[0] =~ /^\s*(\d+)\s+(.*)/;
- # print " <= $exp\n";
- # (0, eval_in_env2($exp, $level));
- # (0, eval_in_env3($exp, peek_my(4 + $level)));
- eval_in_env($exp, peek_my(4+$level));
+ eval_in_env(shift, peek_my(4+$level));
}
# inspect lexicals at level N, or current level
@@ -150,10 +122,9 @@ sub repl_inspect
print "[$i] $sub:\n";
for (sort keys %$h) {
local @Sepia::res = $h->{$_};
- print "\t$_ = ", $Sepia::PRINTER->(), "\n";
+ print "\t$_ = ", $Sepia::PRINTER{$Sepia::PRINTER}->(), "\n";
}
}
- 0;
}
sub debug
@@ -199,12 +170,13 @@ sub repl_break
$arg =~ s/^\s+//;
$arg =~ s/\s+$//;
my ($f, $l, $cond) = $arg =~ /^(.+?):(\d+)\s*(.*)/;
- $cond ||= 1;
+ $cond = 1 unless $cond =~ /\S/;
$f ||= $file;
$l ||= $line;
- print "break ", breakpoint($f, $l, $cond), "\n";
- 0;
-}
+ return unless defined $f && defined $l;
+ my $bp = breakpoint($f, $l, $cond);
+ print "break $bp\n" if $bp;
+ }
sub update_location
{
@@ -222,7 +194,6 @@ sub repl_list
my @lines = eval shift;
@lines = $line - 5 .. $line + 5 unless @lines;
printf '%-6d%s', $_, ${"::_<$file"}[$_-1] for @lines;
- 0
}
sub repl_delete
@@ -232,113 +203,71 @@ sub repl_delete
$l ||= $line;
my $h = breakpoint_file $f;
delete $h->{$l} if defined $h;
- 0
}
-my %parent_repl = (
- delete => \&repl_delete,
- debug => \&repl_debug,
- break => \&repl_break,
- lsbreak => \&repl_lsbreak,
-);
-
-my %parent_doc = (
- break =>
- 'break [F:N [E]] Set a breakpoint in F at line N (or at current
- position), enabled if E evalutes to true.',
- delete =>
- 'delete Delete current breakpoint.',
- debug =>
- 'debug [0|1] Enable or disable debugging.',
- lsbreak =>
- 'lsbreak List breakpoints.',
-);
-
sub add_repl_commands
{
- %Sepia::REPL = (%Sepia::REPL, %parent_repl);
- %Sepia::REPL_DOC = (%Sepia::REPL_DOC, %parent_doc);
+ define_shortcut 'delete', \&repl_delete,
+ 'Delete current breakpoint.';
+ define_shortcut 'debug', \&repl_debug,
+ 'debug [0|1]', 'Enable or disable debugging.';
+ define_shortcut 'break', \&repl_break,
+ 'break [F:N [E]]',
+ 'Set a breakpoint in F at line N (or at current position), enabled if E evalutes to true.';
+ define_shortcut 'lsbreak', \&repl_lsbreak,
+ 'List breakpoints.';
%Sepia::RK = abbrev keys %Sepia::REPL;
}
-my %REPL = (
- up => sub {
+sub add_debug_repl_commands
+{
+
+ define_shortcut up => sub {
$level += shift || 1;
update_location(4);
show_location;
- 0
- },
- down => sub {
+ }, 'up [N]', 'Move up N stack frames.';
+ define_shortcut down => sub {
$level -= shift || 1;
$level = 0 if $level < 0;
update_location(4);
show_location;
- 0
- },
-
- continue => sub {
+ }, 'down [N]', 'Move down N stack frames.';
+ define_shortcut continue => sub {
$level = 0;
- $DB::single = 0; 1
- },
+ $DB::single = 0;
+ last repl;
+ }, 'Yep.';
- next => sub {
+ define_shortcut next => sub {
my $n = shift || 1;
$DB::single = 0;
- breakpoint $file, $line + $n, 'next'; 1
- },
-
- step => sub {
- $DB::single = shift || 1; 1
- },
-
- break => \&repl_break,
-
- list => \&repl_list,
-
- # quit => sub {
- # debug(0);
- # },
- backtrace => \&repl_backtrace,
- inspect => \&repl_inspect,
- # eval => \&repl_upeval,
- return => \&repl_return,
- lsbreak => \&repl_lsbreak,
- eval => \&repl_upeval, # DANGER!
-);
-
-my %REPL_DOC = (
- continue =>
- 'continue Yep.',
- next =>
- 'next [N] Advance N lines, skipping subroutines.',
- list =>
- 'list EXPR List source lines of current file.',
- step =>
- 'step [N] Step N lines forward, entering subroutines.',
- quit =>
- 'quit Exit the current prompt level.',
- up =>
- 'up [N] Move up N stack frames.',
- down =>
- 'down [N] Move down N stack frames.',
- backtrace =>
- 'backtrace show backtrace',
- inspect =>
- 'inspect [N] inspect lexicals in frame N (or current)',
- eval =>
- 'eval EXPR evaluate EXPR in current frame',
- return =>
- 'return EXPR return EXPR',
- quit =>
- 'quit keep on dying/warning',
- );
+ breakpoint $file, $line + $n, 'next';
+ last repl;
+ }, 'next [N]', 'Advance N lines, skipping subroutines.';
+
+ define_shortcut step => sub {
+ $DB::single = shift || 1;
+ last repl;
+ }, 'step [N]', 'Step N lines forward, entering subroutines.';
+
+ define_shortcut list => \&repl_list,
+ 'list EXPR', 'List source lines of current file.';
+ define_shortcut backtrace => \&repl_backtrace, 'show backtrace';
+ define_shortcut inspect => \&repl_inspect,
+ 'inspect [N]', 'inspect lexicals in frame N (or current)';
+ define_shortcut return => \&repl_return, 'return EXPR', 'return EXPR';
+ define_shortcut eval => \&repl_upeval,
+ 'eval EXPR', 'evaluate EXPR in current frame'; # DANGER!
+}
sub repl
{
show_location;
-
- local %Sepia::REPL = (%Sepia::REPL, %REPL, @_);
- local %Sepia::REPL_DOC = (%Sepia::REPL_DOC, %REPL_DOC);
+ local %Sepia::REPL = %Sepia::REPL;
+ local %Sepia::REPL_DOC = %Sepia::REPL_DOC;
+ add_debug_repl_commands;
+ map { define_shortcut @$_ } @_;
local %Sepia::RK = abbrev keys %Sepia::REPL;
# local $Sepia::REPL_LEVEL = $Sepia::REPL_LEVEL + 1;
local $Sepia::PS1 = "*$Sepia::REPL_LEVEL*> ";
@@ -360,7 +289,7 @@ sub DB::DB
if ($cond eq 'next') {
delete $main::{"_<$file"}{$line};
} else {
- return unless eval $cond;
+ return unless $Sepia::REPL{eval}->($cond);
}
}
repl();
@@ -375,16 +304,21 @@ sub die
my @dieargs = @_;
local $level = 0;
local ($pack, $file, $line, $sub) = caller($level);
- print "@_\n\tin $sub\nDied $MSG\n";
+ my $tmp = "@_";
+ $tmp .= "\n" unless $tmp =~ /\n\z/;
+ print "$tmp\tin $sub\nDied $MSG\n";
my $trace = $DB::trace;
$DB::trace = 1;
repl(
- die => sub { local $STOPDIE=0; CORE::die @dieargs },
- quit => sub { local $STOPDIE=0; CORE::die @dieargs });
+ [die => sub { local $STOPDIE=0; CORE::die @dieargs },
+ 'Continue dying.'],
+ [quit => sub { local $STOPDIE=0; CORE::die @dieargs },
+ 'Continue dying.']);
$DB::trace = $trace;
} else {
CORE::die(Carp::shortmess @_);
}
+ 1;
}
sub warn
@@ -398,8 +332,10 @@ sub warn
local ($pack, $file, $line, $sub) = caller($level);
print "@_\n\tin $sub\nWarned $MSG\n";
repl(
- warn => sub { local $STOPWARN=0; CORE::warn @dieargs },
- quit => sub { local $STOPWARN=0; CORE::warn @dieargs });
+ [warn => sub { local $STOPWARN=0; CORE::warn @dieargs },
+ 'Continue warning.'],
+ [quit => sub { local $STOPWARN=0; CORE::warn @dieargs },
+ 'Continue warning.']);
$DB::trace = $trace;
} else {
## Avoid showing up in location information.
diff --git a/lib/Sepia/Xref.pm b/lib/Sepia/Xref.pm
index 737ce8f..1ef357c 100644
--- a/lib/Sepia/Xref.pm
+++ b/lib/Sepia/Xref.pm
@@ -116,6 +116,8 @@ my %code = (intro => "i", used => "",
formdef => "f", meth => "->");
+=head2 Functions
+
=item C<guess_module_file($pack, $ofile)>
XXX: it turns out that rooting around trying to figure out the file
@@ -491,10 +493,6 @@ sub xref_definitions {
walksymtable(\%{"main::"}, "xref", sub { !xref_exclude($_[0]) });
}
-=head2 Functions
-
-=over
-
=item C<rebuild()>
Rebuild the Xref database.
@@ -674,10 +672,13 @@ List the modules defined in file C<$file>.
sub file_modules {
my $file = shift;
- eval "use Module::Include;" and do {
- my $mod = Module::Include->new_from_file(abs_path($file));
- return ($mod && $mod->packages_inside) || undef;
- };
+ eval {
+ require Module::Info;
+ my $mod = Module::Info->new_from_file(abs_path($file));
+ if ( $mod ) {
+ return $mod->packages_inside();
+ }
+ }
}
=item C<var_apropos($expr)>
diff --git a/sepia-ido.el b/sepia-ido.el
index c8f657f..e43742e 100644
--- a/sepia-ido.el
+++ b/sepia-ido.el
@@ -1,5 +1,6 @@
-(require 'ido nil t)
-(require 'cl)
+(eval-when-compile
+ (require 'ido)
+ (require 'cl))
(defun* sepia-icompleting-recursive-read (prompt dir &key
list-fn
@@ -83,7 +84,8 @@ bells-and-whistles. Arguments are:
(defun sepia-jump-to-symbol ()
"Jump to a symbol's definition using ido-like completion."
(interactive)
- (let ((pack (concat (sepia-buffer-package) "::")))
+ (let ((pack (concat (sepia-buffer-package) "::"))
+ ido-case-fold)
(sepia-location
(sepia-icompleting-recursive-read "Jump to: " pack
:list-fn 'sepia-list-fn
diff --git a/sepia-snippet.el b/sepia-snippet.el
new file mode 100644
index 0000000..5fbfb1c
--- /dev/null
+++ b/sepia-snippet.el
@@ -0,0 +1,18 @@
+(eval-when-compile
+ (require 'snippet))
+
+(defun sepia-snippet-abbrev ()
+ (snippet-with-abbrev-table
+ 'sepia-mode-abbrev-table
+ ("for" . "for my $${VAR} ($${LIST}) {\n$>$.\n}$>")
+ ("foreach" . "foreach my $${VAR} ($${LIST}) {\n$>$.\n}$>")
+ ("if" . "if ($${TEST}) {\n$>$.\n}$>")
+ ("elsif" . "elsif ($${TEST}) {\n$>$.\n}$>")
+ ("else" . "else {\n$>$.\n}$>")
+ ("unless" . "unless ($${TEST}) {\n$>$.\n}$>")
+ ("while" . "while ($${TEST}) {\n$>$.\n}$>")
+ ("until" . "until ($${TEST}) {\n$>$.\n}$>")
+ ("for" . "for my $${VAR} ($${LIST}) {\n$>$.\n}$>")
+ ("sub" . "sub $${NAME}\n{\n$>$.\n}$>")))
+
+(add-hook 'sepia-mode-hook 'sepia-snippet-abbrev)
diff --git a/sepia-tree.el b/sepia-tree.el
index 1d0acb4..67e70e4 100644
--- a/sepia-tree.el
+++ b/sepia-tree.el
@@ -10,12 +10,15 @@
;;; Code:
-(require 'tree-widget nil t)
+(require 'tree-widget)
+
+(defvar sepia-tree-use-image nil
+ "*If non-nil, show tree-widget with icons.")
(defun sepia-tree-button-cb (widget &rest blah)
(let* ((pw (widget-get widget :parent))
- (wid-name (widget-get widget :sepia-name))
- (location (and wid-name (xref-location wid-name))))
+ (wid-name (widget-get pw :sepia-name))
+ (location (and wid-name (car (xref-location wid-name)))))
(cond
((not location) (error "Can't find %s." wid-name))
(current-prefix-arg
@@ -67,7 +70,8 @@ will, given a widget, generate its children."
"Get/create a new, tidy buffer for the tree widget."
(switch-to-buffer name)
(kill-all-local-variables)
- (setq widget-image-enable nil);; because the widget images are ugly.
+ ;; because the widget images are ugly.
+ (set (make-local-variable 'widget-image-enable) sepia-tree-use-image)
(let ((inhibit-read-only t))
(erase-buffer))
(let ((all (overlay-lists)))
@@ -79,20 +83,20 @@ will, given a widget, generate its children."
(defun sepia-build-tree-buffer (func defs bufname)
(if defs
(lexical-let ((func func))
- (sepia-tree-tidy-buffer bufname)
- (with-current-buffer bufname
- (dolist (x defs)
- (apply #'widget-create
- (sepia-tree-node
+ (sepia-tree-tidy-buffer bufname)
+ (with-current-buffer bufname
+ (dolist (x defs)
+ (widget-create
+ (sepia-tree-node
(lambda (widget)
(funcall func (widget-get widget :sepia-name)))
x)))
- (use-local-map (copy-keymap widget-keymap))
-;; (local-set-key "\M-." sepia-keymap)
- (sepia-install-keys)
- (let ((view-read-only nil))
- (toggle-read-only 1))
- (goto-char (point-min))
+ (use-local-map (copy-keymap widget-keymap))
+;; (local-set-key "\M-." sepia-keymap)
+;; (sepia-install-keys)
+ (let ((view-read-only nil))
+ (toggle-read-only 1))
+ (goto-char (point-min))
(message "Type C-h m for usage information")))
(message "No items for %s" bufname)))
diff --git a/sepia-w3m.el b/sepia-w3m.el
index 7fe615c..6f1e6ed 100644
--- a/sepia-w3m.el
+++ b/sepia-w3m.el
@@ -33,7 +33,8 @@
;; http://emacs-w3m.namazu.org/
;;; Code:
-(require 'w3m-perldoc nil t)
+(eval-when-compile
+ (require 'w3m-perldoc))
;;;###autoload
(defun w3m-about-perldoc-buffer (url &optional no-decode no-cache &rest args)
@@ -45,7 +46,7 @@
(process-environment (copy-sequence process-environment)))
;; To specify the place in which pod2html generates its cache files.
(setenv "HOME" (expand-file-name w3m-profile-directory))
- (insert-buffer buf)
+ (insert-buffer-substring buf)
(when (zerop (apply #'call-process-region
(point-min) (point-max)
w3m-perldoc-pod2html-command
@@ -67,9 +68,11 @@
;;;###autoload
(defun sepia-w3m-view-pod (&optional buffer)
+ (require 'w3m)
(w3m-goto-url (concat "about://perldoc-buffer/"
(w3m-url-encode-string (buffer-name buffer)))))
+;;;###autoload
(defun sepia-module-list ()
"List installed modules with links to their documentation.
@@ -82,6 +85,7 @@ package."
(sepia-eval (format "Sepia::html_module_list(\"%s\")" file)))
(w3m-find-file file)))
+;;;###autoload
(defun sepia-package-list ()
"List installed packages with links to their documentation.
@@ -93,6 +97,34 @@ For modules within packages, see `sepia-module-list'."
(sepia-eval (format "Sepia::html_package_list(\"%s\")" file)))
(w3m-find-file file)))
+(defun sepia-w3m-create-imenu ()
+ "Create imenu index from pod2html output."
+ (save-excursion
+ (goto-char (point-min))
+ (when (looking-at "Location: \\(about://perldoc/[^#]+\\)")
+ (let ((base (match-string 1))
+ beg end
+ list)
+ (w3m-view-source)
+ (search-forward "<!-- INDEX BEGIN -->")
+ (setq beg (point))
+ (search-forward "<!-- INDEX END -->")
+ (setq end (point))
+ (goto-char beg)
+ (while (re-search-forward "<a href=\"\\(#[^\"]+\\)\">\\([^<]+\\)" end t)
+ (push (cons (match-string 2) (match-string 1)) list))
+ (w3m-view-source)
+ (nreverse list)))))
+
+(defun sepia-w3m-goto-function (name anchor)
+ (if (string-match "^about://perldoc/" w3m-current-url)
+ (w3m-goto-url (concat w3m-current-url anchor))
+ (imenu-default-goto-function name anchor)))
+
+(defun sepia-w3m-install-imenu ()
+ (setq imenu-create-index-function 'sepia-w3m-create-imenu
+ imenu-default-goto-function 'sepia-w3m-goto-function))
+
(provide 'sepia-w3m)
;;; sepia-w3m.el ends here.
diff --git a/sepia.el b/sepia.el
index a0a7f86..a44fa50 100644
--- a/sepia.el
+++ b/sepia.el
@@ -21,9 +21,9 @@
(require 'gud)
(require 'cl)
;; try optional modules, but don't bitch if we fail:
-(require 'sepia-w3m nil t)
-(require 'sepia-tree nil t)
-(require 'sepia-ido nil t)
+(ignore-errors (require 'sepia-w3m))
+(ignore-errors (require 'sepia-tree))
+(ignore-errors (require 'sepia-ido))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Comint communication
@@ -34,12 +34,6 @@
(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 current buffer's documentation.
@@ -98,43 +92,42 @@ look for \";;;###\" lisp evaluation markers.")
(defun sepia-eval-raw (str)
"Evaluate perl code STR, returning a pair (RESULT-STRING . OUTPUT)."
- (if (sepia-live-p)
- (let (ocpof)
- (unwind-protect
- (let ((sepia-output "")
- (start 0))
- (with-current-buffer (process-buffer sepia-process)
- (setq ocpof comint-preoutput-filter-functions
- comint-preoutput-filter-functions
- '(sepia-collect-output)))
- (setq str (concat "local $Sepia::STOPDIE=0;"
- "local $Sepia::STOPWARN=0;"
- "{ package " (sepia-buffer-package) ";"
- str " }\n"))
- (comint-send-string sepia-process
- (concat (format "<<%d\n" (length str)) str))
- (while (not (and sepia-output
- (string-match "> $" sepia-output)))
- (accept-process-output sepia-process))
- (if (string-match "^;;;[0-9]+\n" sepia-output)
- (cons
- (let* ((x (read-from-string sepia-output
- (+ (match-beginning 0) 3)))
- (len (car x))
- (pos (cdr x)))
- (prog1 (substring sepia-output (1+ pos) (+ len pos 1))
- (setq start (+ pos len 1))))
- (and (string-match ";;;[0-9]+\n" sepia-output start)
- (let* ((x (read-from-string
- sepia-output
- (+ (match-beginning 0) 3)))
- (len (car x))
- (pos (cdr x)))
- (substring sepia-output (1+ pos) (+ len pos 1)))))
- (cons sepia-output nil)))
- (with-current-buffer (process-buffer sepia-process)
- (setq comint-preoutput-filter-functions ocpof))))
- '("")))
+ (sepia-ensure-process)
+ (let (ocpof)
+ (unwind-protect
+ (let ((sepia-output "")
+ (start 0))
+ (with-current-buffer (process-buffer sepia-process)
+ (setq ocpof comint-preoutput-filter-functions
+ comint-preoutput-filter-functions
+ '(sepia-collect-output)))
+ (setq str (concat "local $Sepia::STOPDIE=0;"
+ "local $Sepia::STOPWARN=0;"
+ "{ package " (sepia-buffer-package) ";"
+ str " }\n"))
+ (comint-send-string sepia-process
+ (concat (format "<<%d\n" (length str)) str))
+ (while (not (and sepia-output
+ (string-match "> $" sepia-output)))
+ (accept-process-output sepia-process))
+ (if (string-match "^;;;[0-9]+\n" sepia-output)
+ (cons
+ (let* ((x (read-from-string sepia-output
+ (+ (match-beginning 0) 3)))
+ (len (car x))
+ (pos (cdr x)))
+ (prog1 (substring sepia-output (1+ pos) (+ len pos 1))
+ (setq start (+ pos len 1))))
+ (and (string-match ";;;[0-9]+\n" sepia-output start)
+ (let* ((x (read-from-string
+ sepia-output
+ (+ (match-beginning 0) 3)))
+ (len (car x))
+ (pos (cdr x)))
+ (substring sepia-output (1+ pos) (+ len pos 1)))))
+ (cons sepia-output nil)))
+ (with-current-buffer (process-buffer sepia-process)
+ (setq comint-preoutput-filter-functions ocpof)))))
(defun sepia-eval (str &optional context detailed)
"Evaluate STR in CONTEXT (void by default), and return its result
@@ -170,7 +163,7 @@ each inferior Perl prompt."
(setq sepia-passive-output (concat sepia-passive-output string))
(cond
((string-match "^;;;###[0-9]+" sepia-passive-output)
- (when (string-match "^;;;###\\([0-9]+\\)\n\\(?:.\\|\n\\)*\\(\n.*> \\)"
+ (if (string-match "^;;;###\\([0-9]+\\)\n\\(?:.\\|\n\\)*\n\\(.*> \\)"
sepia-passive-output)
(let* ((len (car (read-from-string
(match-string 1 sepia-passive-output))))
@@ -178,15 +171,14 @@ each inferior Perl prompt."
(res (ignore-errors (eval (car (read-from-string
sepia-passive-output pos
(+ pos len)))))))
- (insert (format "%s => %s\n"
- (substring sepia-passive-output pos (+ pos len)) res))
+ (message "%s => %s"
+ (substring sepia-passive-output pos (+ pos len)) res)
(goto-char (point-max))
- (comint-set-process-mark)
- (sepia-eval "''" 'scalar-context)
- (message "%s => %s" (substring sepia-passive-output pos (+ pos len))
- res)
- (setq sepia-passive-output "")))
- "")
+ (insert (substring sepia-passive-output (+ 1 pos len)))
+ (set-marker (process-mark (get-buffer-process (current-buffer)))
+ (point))
+ (setq sepia-passive-output ""))
+ ""))
(t (setq sepia-passive-output "") string)))
@@ -225,6 +217,7 @@ might want to bind your keys, which works best when bound to
(define-key map "\C-c\C-d" 'sepia-view-pod)
(define-key map "\C-c\C-r" 'sepia-repl)
(define-key map "\C-c\C-s" 'sepia-scratch)
+ (define-key map "\C-c\C-e" 'sepia-eval-expression)
(define-key map "\C-c!" 'sepia-set-cwd)
(define-key map (kbd "TAB") 'sepia-indent-or-complete)
map)
@@ -244,7 +237,7 @@ might want to bind your keys, which works best when bound to
(w3m-about-perldoc-buffer (&rest args)
(let ((res (apply old-pdb args)))
(or res (error "lose: %s" args)))))
- (funcall sepia-perldoc-function name))
+ (funcall (if (featurep 'w3m) 'w3m-perldoc 'cperl-perldoc) name))
(error (set-window-configuration wc)))))
(defun sepia-view-pod ()
@@ -297,29 +290,37 @@ For modules within packages, see `sepia-module-list'."
(and (processp sepia-process)
(eq (process-status sepia-process) 'run)))
-;;;###autoload
-(defun sepia-repl ()
- "Start the Sepia REPL."
- (interactive)
- (sepia-init) ;; set up keymaps, etc.
+(defun sepia-ensure-process (&optional remote-host)
(unless (sepia-live-p)
- (setq sepia-process
- (get-buffer-process
- (comint-exec (get-buffer-create "*sepia-repl*")
- "perl" sepia-program-name nil
- (append (mapcar (lambda (x) (concat "-I" x))
- sepia-perl5lib)
- '("-MSepia" "-MSepia::Xref"
- "-e" "Sepia::repl(*STDIN, *STDOUT)")))))
- (with-current-buffer "*sepia-repl*"
- (sepia-repl-mode))
+ (with-current-buffer (get-buffer-create "*sepia-repl*")
+ (sepia-repl-mode)
+ (set (make-local-variable 'sepia-passive-output) ""))
+ (if remote-host
+ (comint-exec "*sepia-repl*" "attachtty" "attachtty" nil
+ (list remote-host))
+ (let ((stuff (split-string sepia-program-name nil t)))
+ (comint-exec (get-buffer-create "*sepia-repl*")
+ "perl" (car stuff) nil
+ (append
+ (cdr stuff)
+ (mapcar (lambda (x) (concat "-I" x)) sepia-perl5lib)
+ '("-MSepia" "-MSepia::Xref"
+ "-e" "Sepia::repl")))))
+ (setq sepia-process (get-buffer-process "*sepia-repl*"))
(accept-process-output sepia-process 0 1)
;; Steal a bit from gud-common-init:
(setq gud-running t)
(setq gud-last-last-frame nil)
(set-process-filter sepia-process 'gud-filter)
- (set-process-sentinel sepia-process 'gud-sentinel)
- )
+ (set-process-sentinel sepia-process 'gud-sentinel)))
+
+;;;###autoload
+(defun sepia-repl (&optional remote-host)
+ "Start the Sepia REPL."
+ (interactive (list (and current-prefix-arg
+ (read-string "Host: "))))
+ (sepia-init) ;; set up keymaps, etc.
+ (sepia-ensure-process remote-host)
(pop-to-buffer (get-buffer "*sepia-repl*")))
(defvar sepia-repl-mode-map
@@ -388,24 +389,25 @@ For modules within packages, see `sepia-module-list'."
(pl-name (sepia-perl-name name package)))
(fmakunbound lisp-name)
(eval `(defun ,lisp-name (&rest args)
- ,doc
- (apply #'sepia-call ,pl-name 'list-context args)))))
+ ,doc
+ (apply #'sepia-call ,pl-name 'list-context args)))))
-(defun define-modinfo-function (name &optional doc)
+(defun define-modinfo-function (name &optional doc context)
"Define a lisp mirror for a function from Module::Info."
(let ((name (intern (format "sepia-module-%s" name)))
- (pl-func (sepia-perl-name name))
+ (pl-func (sepia-perl-name name))
(full-doc (concat (or doc "") "
This function uses Module::Info, so it does not require that the
module in question be loaded.")))
(when (fboundp name) (fmakunbound name))
(eval `(defun ,name (mod)
- ,full-doc
- (interactive (list (sepia-interactive-arg 'module)))
+ ,full-doc
+ (interactive (list (sepia-interactive-arg 'module)))
(sepia-maybe-echo
- (sepia-call "Sepia::module_info" 'scalar-context
- mod ,pl-func))))))
+ (sepia-call "Sepia::module_info" ',(or context 'scalar-context)
+ mod ,pl-func)
+ (interactive-p))))))
(defun sepia-thing-at-point (what)
"Like `thing-at-point', but hacked to avoid REPL prompt."
@@ -416,27 +418,33 @@ module in question be loaded.")))
(defvar sepia-history nil)
-(defun sepia-interactive-arg (&optional type)
+(defun sepia-interactive-arg (&optional sepia-arg-type)
"Default argument for most Sepia functions. TYPE is a symbol --
either 'file to look for a file, or anything else to use the
symbol at point."
- (let* ((default (case type
+ (let* ((default (case sepia-arg-type
(file (or (thing-at-point 'file) (buffer-file-name)))
- (t (sepia-thing-at-point 'symbol))))
- (text (capitalize (symbol-name type)))
- (choices (lambda (str &rest blah)
- (let ((str (concat "^" str)))
- (case type
- (variable (xref-var-apropos str))
- (function (xref-apropos str))
- (module (xref-mod-apropos str))
- (t nil)))))
+ (t (sepia-thing-at-point 'symbol))))
+ (text (capitalize (symbol-name sepia-arg-type)))
+ (choices
+ (lambda (str &rest blah)
+ (let ((completions (xref-completions
+ str
+ (case sepia-arg-type
+ (module nil)
+ (variable "VARIABLE")
+ (function "CODE")
+ (t nil)))))
+ (when (eq sepia-arg-type 'module)
+ (setq completions
+ (remove-if (lambda (x) (string-match "::$" x)) completions)))
+ completions)))
(prompt (if default
(format "%s [%s]: " text default)
(format "%s: " text)))
(ret (if sepia-use-completion
- (completing-read prompt choices nil nil nil 'sepia-history
- default)
+ (completing-read prompt 'blah-choices nil nil nil 'sepia-history
+ default)
(read-string prompt nil 'sepia-history default))))
(push ret sepia-history)
ret))
@@ -449,11 +457,11 @@ would be to choose the module based on what we know about the
symbol at point."
(let ((xs (xref-file-modules (buffer-file-name))))
(if (= (length xs) 1)
- (car xs)
- nil)))
+ (car xs)
+ nil)))
-(defun sepia-maybe-echo (result)
- (when (interactive-p)
+(defun sepia-maybe-echo (result &optional print-message)
+ (when print-message
(message "%s" result))
result)
@@ -531,14 +539,14 @@ buffer.
,(if test
`(let ((tmp (,gen ident module file line)))
(or (mapcan #',test tmp) tmp))
- `(,gen ident module file line))))
+ `(,gen ident module file line))))
;; Always clear out the last found ring, because it's confusing
;; otherwise.
- (sepia-set-found nil ',(or prompt 'function))
+ (sepia-set-found nil ,(or prompt ''function))
(if display-p
- (sepia-show-locations ret)
- (sepia-set-found ret ',(or prompt 'function))
- (sepia-next)))))
+ (sepia-show-locations ret)
+ (sepia-set-found ret ,(or prompt ''function))
+ (sepia-next)))))
(define-sepia-query sepia-defs
"Find all definitions of sub."
@@ -573,12 +581,6 @@ buffer.
(lambda (x) (setf (third x) ident) (list x))
'variable)
-(define-sepia-query sepia-module-describe
- "Find all subroutines in a package."
- xref-mod-subs
- nil
- 'module)
-
(defalias 'sepia-package-defs 'sepia-module-describe)
(define-sepia-query sepia-apropos
@@ -602,7 +604,7 @@ to this location."
(let* ((fl (or (car (xref-location name))
(car (remove-if #'null
(apply #'xref-location (xref-apropos name)))))))
- (when (and fl (string-match "^(eval " (car fl)))
+ (when (and (car fl) (string-match "^(eval " (car fl)))
(message "Can't find definition of %s in %s." name (car fl))
(setq fl nil))
(if jump-to
@@ -717,7 +719,6 @@ The prefix argument is the same as for `end-of-defun'."
(defun sepia-defun-around-point (&optional where)
"Return the text of function around point."
- (interactive "d")
(unless where
(setq where (point)))
(save-excursion
@@ -744,7 +745,11 @@ also rebuild the xref database."
prefix-arg
(format "*%s errors*" (buffer-file-name))))
(save-buffer)
- (let* ((tmp (sepia-eval (format "do '%s' || ($@ && die $@)" file)
+ (when collect-warnings
+ (let (kill-buffer-query-functions)
+ (ignore-errors
+ (kill-buffer collect-warnings))))
+ (let* ((tmp (sepia-eval (format "do '%s' || ($@ && do { local $Sepia::Debug::STOPDIE; die $@ })" file)
'scalar-context t))
(res (car tmp))
(errs (cdr tmp)))
@@ -761,16 +766,14 @@ also rebuild the xref database."
(xref-rebuild)))
(defvar sepia-found)
-(defvar sepia-found-head)
(defun sepia-set-found (list &optional type)
(setq list
(remove-if (lambda (x)
(or (not x)
(and (not (car x)) (string= (fourth x) "main"))))
- list))
- (setq sepia-found list
- sepia-found-head list)
+ list))
+ (setq sepia-found (cons -1 list))
(setq sepia-found-refiner (sepia-refiner type)))
(defun sepia-refiner (type)
@@ -778,21 +781,20 @@ also rebuild the xref database."
(function
(lambda (line ident)
(let ((sub-re (concat "^\\s *sub\\s +.*" ident "\\_>")))
- ;; Test this because sometimes we get lucky and get the line
- ;; just right, in which case beginning-of-defun goes to the
- ;; previous defun.
- (unless (looking-at sub-re)
- (or (and line
- (progn
- (goto-line line)
+ ;; Test this because sometimes we get lucky and get the line
+ ;; just right, in which case beginning-of-defun goes to the
+ ;; previous defun.
+ (or (and line
+ (progn
+ (goto-line line)
(beginning-of-defun)
- (looking-at sub-re)))
- (progn (goto-char (point-min))
- (re-search-forward sub-re nil t)))
- (beginning-of-line)))))
+ (looking-at sub-re)))
+ (progn (goto-char (point-min))
+ (re-search-forward sub-re nil t)))
+ (beginning-of-line))))
;; Old version -- this may actually work better if
;; beginning-of-defun goes flaky on us.
-;; (or (re-search-backward sub-re
+;; (or (re-search-backward sub-re
;; (sepia-bol-from (point) -20) t)
;; (re-search-forward sub-re
;; (sepia-bol-from (point) 10) t))
@@ -805,31 +807,73 @@ also rebuild the xref database."
(or (re-search-backward var-re (sepia-bol-from (point) -5) t)
(re-search-forward var-re (sepia-bol-from (point) 5) t)))
(t (goto-char (point-min))
- (re-search-forward var-re nil t))))))
+ (re-search-forward var-re nil t))))))
(t (lambda (line ident) (and line (goto-line line))))))
-(defun sepia-next ()
-"Go to the next thing (e.g. def, use) found by sepia."
- (interactive)
- (if sepia-found
- (destructuring-bind (file line short &optional mod &rest blah)
- (car sepia-found)
- (unless file
- (setq file (and mod (sepia-find-module-file mod)))
- (if file
- (setf (caar sepia-found) file)
- (error "No file for %s." (car sepia-found))))
- (message "%s at %s:%s" short file line)
+(defun sepia-next (&optional arg)
+ "Go to the next thing (e.g. def, use) found by sepia."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (if (cdr sepia-found)
+ (let ((i (car sepia-found))
+ (list (cdr sepia-found))
+ (len (length (cdr sepia-found)))
+ (next (+ (car sepia-found) arg))
+ (prompt ""))
+ (if (and (= len 1) (>= i 0))
+ (message "No more definitions.")
+ ;; if stepwise found next or previous item, it can cycle
+ ;; around the `sepia-found'. When at first or last item, get
+ ;; a warning
+ (if (= (abs arg) 1)
+ (progn
+ (setq i next)
+ (if (< i 0)
+ (setq i (1- len))
+ (if (>= i len)
+ (setq i 0)))
+ (if (= i (1- len))
+ (setq prompt "Last one! ")
+ (if (= i 0)
+ (setq prompt "First one! "))))
+ ;; if we skip several item, when arrive the first or last
+ ;; item, we will stop at the one. But if we already at last
+ ;; item, then keep going
+ (if (< next 0)
+ (if (= i 0)
+ (setq i (mod next len))
+ (setq i 0
+ prompt "First one!"))
+ (if (> next len)
+ (if (= i (1- len))
+ (setq i (mod next len))
+ (setq i (1- len)
+ prompt "Last one!")))))
+ (setcar sepia-found i)
+ (setq next (nth i list))
+ (let ((file (car next))
+ (line (cadr next))
+ (short (nth 2 next))
+ (mod (nth 3 next)))
+ (unless file
+ (setq file (and mod (sepia-find-module-file mod)))
+ (if file
+ (setcar next file)
+ (error "No file for %s." (car next))))
+ (message "%s at %s:%s. %s" short file line prompt)
(when (file-exists-p file)
(find-file (or file (sepia-find-module-file mod)))
(when sepia-found-refiner
(funcall sepia-found-refiner line short))
(beginning-of-line)
- (recenter)
- (setq sepia-found (or (cdr sepia-found)
- sepia-found-head))))
+ (recenter)))))
(message "No more definitions.")))
+(defun sepia-previous (&optional arg)
+ (interactive "p")
+ (or arg (setq arg 1))
+ (sepia-next (- arg)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Completion
@@ -917,6 +961,21 @@ expressions would lead to disaster."
(cadr (sepia-ident-at-point))))))
(error nil)))
+(defun sepia-repl-complete ()
+ "Try to complete the word at point in the REPL.
+Just like `sepia-complete-symbol', except that it also completes
+REPL shortcuts."
+ (interactive)
+ (error "TODO"))
+
+(defvar sepia-shortcuts
+ '("break" "cd" "debug" "define" "delete" "eval" "format" "help" "lsbreak"
+ "methods" "package" "pwd" "quit" "reload" "shell" "size" "strict" "undef"
+ "wantarray")
+ "List of currently-defined REPL shortcuts.
+
+XXX: this needs to be updated whenever you add one on the Perl side.")
+
(defun sepia-complete-symbol ()
"Try to complete the word at point.
The word may be either a global variable if it has a
@@ -942,12 +1001,20 @@ The function is intended to be bound to \\M-TAB, like
(with-current-buffer (window-buffer win)
(if (pos-visible-in-window-p (point-max) win)
(set-window-start win (point-min))
- (save-selected-window
- (select-window win)
- (scroll-up))))
+ (save-selected-window
+ (select-window win)
+ (scroll-up))))
- ;; Otherwise actually do completion:
- ;; 1 - Look for a method call:
+ ;; Otherwise actually do completion:
+ ;; 0 - try a shortcut
+ (save-excursion
+ (comint-bol)
+ (when (looking-at ",\\([a-z]+\\)\\(?:\\s \\|$\\)")
+ (let ((str (match-string 1)))
+ (setq len (length str)
+ completions (all-completions str sepia-shortcuts)))))
+ ;; 1 - Look for a method call:
+ (unless completions
(setq meth (sepia-simple-method-before-point))
(when meth
(setq len (length (caddr meth))
@@ -955,46 +1022,46 @@ The function is intended to be bound to \\M-TAB, like
(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)
+ type (format "%s->" (car meth)))))
+ (multiple-value-bind (typ name) (sepia-ident-before-point)
+ (unless completions
;; 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 ""))
- (and (eq major-mode 'sepia-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
- (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 (<= (length new) (length 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)))
+ (setq type typ
+ len (+ (if type 1 0) (length name))
+ completions (xref-completions
+ name
+ (case type
+ (?$ "VARIABLE")
+ (?@ "ARRAY")
+ (?% "HASH")
+ (?& "CODE")
+ (?* "IO")
+ (t ""))
+ (and (eq major-mode 'sepia-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.") nil)
+ (1 ;; XXX - skip sigil to match s-i-before-point
+ (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 (<= (length new) (length 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)))
(defun sepia-indent-or-complete ()
"Indent the current line or complete the symbol around point.
@@ -1024,10 +1091,14 @@ This function is intended to be bound to TAB."
map)
"Keymap for Sepia mode.")
+(defvar sepia-mode-abbrev-table nil
+"Abbrevs for Sepia mode.")
+
;;;###autoload
(define-derived-mode sepia-mode cperl-mode "Sepia"
"Major mode for Perl editing, derived from cperl mode.
\\{sepia-mode-map}"
+ :abbrev-table nil
(sepia-init)
(sepia-install-eldoc)
(sepia-doc-update)
@@ -1047,9 +1118,9 @@ This function is intended to be bound to TAB."
(file "Absolute path of file defining this module.\n\nDoes not require loading.")
(is-core "Guess whether or not a module is part of the core distribution.
Does not require loading.")
- (modules-used "List modules used by this module.\n\nRequires loading.")
- (packages-inside "List sub-packages in this module.\n\nRequires loading.")
- (superclasses "List module's superclasses.\n\nRequires loading.")))
+ (modules-used "List modules used by this module.\n\nRequires loading." list-context)
+ (packages-inside "List sub-packages in this module.\n\nRequires loading." list-context)
+ (superclasses "List module's superclasses.\n\nRequires loading." list-context)))
(apply #'define-modinfo-function x))
;; Create low-level wrappers for Sepia
(dolist (x '((completions "Find completions in the symbol table.")
@@ -1210,7 +1281,7 @@ With prefix arg, replace the region with the result."
(fourth (car defs)))
(and file
(fourth (find-if (lambda (x) (equal (car x) file)) defs)))
- (car (xref-file-modules file))
+ ;; (car (xref-file-modules file))
(sepia-buffer-package))))
;;;###autoload
@@ -1260,7 +1331,7 @@ With prefix arg, replace the region with the result."
(when message-p (message "%s" res))
res))
-(defun sepia-extract-def (file line obj mod)
+(defun sepia-extract-def (file line obj)
(with-current-buffer (find-file-noselect (expand-file-name file))
(save-excursion
(funcall (sepia-refiner 'function) line obj)
@@ -1291,7 +1362,7 @@ With prefix arg, replace the region with the result."
When called interactively, the current buffer's
`default-directory' is used."
- (interactive (list default-directory))
+ (interactive (list (expand-file-name default-directory)))
(sepia-call "Cwd::chdir" dir))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1370,7 +1441,7 @@ used for eldoc feedback."
(defun sepia-looks-like-module (obj)
(let (case-fold-search)
- (or (string-match "^\\([A-Z].*::\\)?[A-Z]+[A-Za-z0-9]+\\sw*$" obj)
+ (or (string-match "^\\([A-Z][A-Za-z0-9]+::\\)*[A-Z]+[A-Za-z0-9]+\\sw*$" obj)
(string-match
(eval-when-compile (regexp-opt '("strict" "vars" "warnings" "lib")))
obj))))
@@ -1395,7 +1466,7 @@ calling `cperl-describe-perl-symbol'."
(flet ((message (&rest blah) (apply #'format blah)))
(let* (case-fold-search
(cperl-message-on-help-error nil)
- (hlp (car (cperl-describe-perl-symbol obj))))
+ (hlp (car (save-excursion (cperl-describe-perl-symbol obj)))))
(if hlp
(progn
;; cperl's docstrings are too long.
@@ -1404,7 +1475,11 @@ calling `cperl-describe-perl-symbol'."
(concat (substring hlp 0 72) "...")
hlp))
;; Try to see if it's a module
- (if (sepia-looks-like-module obj)
+ (if (and
+ (let ((bol (save-excursion (beginning-of-line)
+ (point))))
+ (looking-back " *\\(?:use\\|require\\|package\\) +[^ ]+" bol))
+ (sepia-looks-like-module obj))
(sepia-core-version obj)
""))))
"")))
@@ -1466,7 +1541,7 @@ calling `cperl-describe-perl-symbol'."
(if (member type '(?% ?$ ?@ ?*))
pname
(concat "\\*" pname))))
- ((stringp thing) (format "\'%s\'" thing))
+ ((stringp thing) (format "%S" (substring-no-properties thing 0)))
((integerp thing) (format "%d" thing))
((numberp thing) (format "%g" thing))
;; Perl expression
diff --git a/sepia.texi b/sepia.texi
index 3bdfd83..62703b0 100644
--- a/sepia.texi
+++ b/sepia.texi
@@ -408,6 +408,17 @@ abbreviated to the shortest unique prefix.
@item cd @var{dir}
Change Perl's current directory to @var{dir}.
+ at item debug [@var{val}]
+Turn Sepia debugger hook on or off, or toggle if @var{val} is missing.
+
+ at item define @var{name} ['@var{doc}'] @var{body...}
+Define @var{name} as a shortcut for Perl code @var{body}, with optional
+documentation @var{doc}, surrounded by single quotes. @var{body} is
+passed the raw command-line text as its first argument.
+
+ at item delete
+Delete the current breakpoint.
+
@item format @var{type}
Set the output format to @var{type}, either ``dumper'' (using
@code{Data::Dumper}), ``dump'' (@code{Data::Dump}), ``yaml''
@@ -416,6 +427,9 @@ Set the output format to @var{type}, either ``dumper'' (using
@item help
Display a list of shortcuts.
+ at item lsbreak
+List breakpoints.
+
@item methods @var{name} [@var{regexp}]
Display a list of functions defined in package @var{name} and its
@code{ISA}-ancestors matching optional pattern @var{regexp}.
@@ -423,6 +437,9 @@ Display a list of functions defined in package @var{name} and its
@item package @var{name}
Set the default evaluation package to @var{name}.
+ at item pwd
+Show the process's current working directory.
+
@item quit
Exit the inferior Perl process.
@@ -439,13 +456,18 @@ Set evaluation strictness to @var{val}, or toggle it if @var{val} is not
given. Note that turning strictness off and on clears the REPL's
lexical environment.
+ at item undef @var{name}
+Undefine shortcut @var{name}. @strong{Warning}: this can equally be
+used to remove built-in shortcuts.
+
@item wantarray [@var{val}]
Set the evaluation context to @var{val}, or toggle between scalar and
array context.
- at item who [@var{name} [@var{regexp}]]
-List identifiers in package @var{name} (main by default) matching
-optional pattern @var{regexp}.
+ at item who @var{package} [@var{regexp}]
+ at itemx who [@var{regexp}]
+List identifiers in @var{package} (main by default) matching
+optional @var{regexp}.
@end table
@@ -454,7 +476,7 @@ optional pattern @var{regexp}.
Sepia uses Perl's debugger hooks and GUD mode to support conditional
breakpoints and single-stepping, and overrides Perl's @code{die()} to
-invoke the debugger rather than unwinding the stack. This makes it
+invoke the debugger rather than unwind the stack. This makes it
possible to produce a backtrace, inspect and modify global variables,
and even continue execution when a program tries to kill itself. If the
PadWalker module is available, Sepia also provides functions to inspect
@@ -574,11 +596,7 @@ the result on the next line.
@chapter Customization
While Sepia can be customized in both the Perl and Emacs Lisp, most of
-the user-accessible configuration is in the latter. The two variables
-most likely to need customization are @kbd{sepia-program-name} and
- at kbd{sepia-perl5lib}. Since Sepia tries where possible to reuse
-existing Emacs functionality, its behavior should already be covered by
-existing customizations.
+the user-accessible configuration is in the latter.
@menu
* Emacs Variables::
@@ -588,6 +606,13 @@ existing customizations.
@node Emacs Variables, Perl Variables, Customization, Customization
@section Emacs Variables
+Since Sepia tries where possible to reuse existing Emacs functionality,
+its behavior should already be covered by existing customizations. The
+two variables most likely to need customization are
+ at kbd{sepia-program-name} and @kbd{sepia-perl5lib}. General Sepia mode
+configuration can be done with @kbd{sepia-mode-hook}, while
+REPL-specific configuration can be done with @kbd{sepia-repl-mode-hook}.
+
@table @kbd
@item sepia-complete-methods
@@ -644,6 +669,7 @@ Default: @code{sepia-w3m-view-pod} if Emacs-w3m is available, or
@node Perl Variables, , Emacs Variables, Customization
@section Perl Variables
+When Sepia starts up, it evaluates the Perl script in @file{~/.sepiarc}.
The following variables in the Sepia package control various aspects of
interactive evaluation.
@@ -679,6 +705,17 @@ If true, evaluate interactive expressions in list context. Default: true.
@end table
+Additional REPL shortcuts can be defined with
+ at kbd{Sepia::define_shortcut}. For example
+
+ at example
+Sepia::define_shortcut time => sub @{ print scalar localtime, "\n"; 0 @},
+ 'Display the current time.';
+ at end example
+
+defines a shortcut ``time'' that displays the current time. For
+details, see the code in @file{Sepia.pm}.
+
@c ============================================================
@node Internals, Credits, Customization, Top
@chapter Internals
@@ -691,11 +728,18 @@ developer documentation, please see the POD for @code{Sepia} and
@node Credits, Function Index, Internals, Top
@unnumbered Credits
-I would like to thank Hilko Bengen for finding and motivating me to fix
-a bunch of bugs, and for doing the Debian packaging.
+ at table @asis
+ at item Hilko Bengen
+Found and motivated me to fix a bunch of bugs, created Debian packages.
+
+ at item Ye Wenbin
+Found and fixed numerous bugs.
-I would also like to thank the authors of Emacs-w3m, SLIME, ido, and
-B::Xref for the code I stole.
+ at item Free Software
+Portions of the code were lifted from Emacs-w3m, SLIME, ido, and
+B::Xref, all of which are Free software.
+
+ at end table
@c ============================================================
@node Function Index, , Credits, Top
diff --git a/t/01basic.t b/t/01basic.t
index cb52d2c..72cbc0a 100644
--- a/t/01basic.t
+++ b/t/01basic.t
@@ -1,5 +1,5 @@
#!/usr/bin/env perl
-use Test::Simple tests => 18;
+use Test::Simple tests => 15;
require Data::Dumper;
require Sepia;
@@ -39,30 +39,13 @@ apply_to_loc(\&Sepia::Xref::callees);
my @subs = Sepia::mod_subs('Sepia');
ok(all(map { defined &{"Sepia::$_"} } @subs), 'mod_subs');
-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);
-
- ## Weird Module::Info bug: works with
- ## PERL5LIB=$PWD/blib/lib perl test.pl
- ## but fails with
- ## perl -Iblib/lib test.pl
-if (0 && exists $INC{'Module/Info.pm'}) {
- my %mu;
- undef @mu{Sepia::module_info('Sepia', 'modules_used')};
-
- my @mu_exp = qw(B Cwd Exporter Module::Info Scalar::Util
- Sepia::Debug Text::Abbrev strict vars);
-
- ok(all(map { exists $mu{$_} } @mu_exp), "uses (@mu_exp) (@{[sort keys %mu]}");
- ok((Sepia::module_info('Sepia', 'packages_inside'))[0] eq 'Sepia');
- ok((Sepia::module_info('Sepia', 'superclasses'))[0] eq 'Exporter');
+if (exists $INC{'Module/Info.pm'}) {
+ 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);
} else {
- ok(1, "no module info");
- ok(1, "no module info");
- ok(1, "no module info");
+ ok(1, 'skipped -- no Module::Info') for 1..4;
}
-# 18 to here.
exit;
diff --git a/t/02completion.t b/t/02completion.t
new file mode 100644
index 0000000..e9f6c8f
--- /dev/null
+++ b/t/02completion.t
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+use Test::Simple tests => 11;
+use Data::Dumper;
+require Sepia;
+no warnings;
+
+## Set up some symbols to complete on:
+package Z::A;
+sub a_function { }
+sub a_nother_function { }
+$a_var = 0;
+ at a_var2 = ();
+%a_var3 = ();
+package Z::Another;
+sub a_function { }
+sub a_nother_function { }
+$a_var = 0;
+ at a_var2 = ();
+%a_var3 = ();
+package Z::A::Nother;
+sub a_function { }
+sub a_nother_function { }
+$a_var = 0;
+ at a_var2 = ();
+%a_var3 = ();
+package Z::Blah;
+sub a_function { }
+sub a_nother_function { }
+$a_var = 0;
+ at a_var2 = ();
+%a_var3 = ();
+## Whew!
+package main;
+
+sub ok_comp
+{
+ my $str = shift;
+ my $res = Dumper([sort(Sepia::completions($str))]);
+ my $expect = Dumper([sort @_]);
+ my $ok = $res eq $expect;
+ ok($ok, $ok ? $str : "$str\n$res\n$expect\n");
+}
+
+ok_comp('$Z:A:a_v', qw($Z::A::a_var $Z::Another::a_var));
+ok_comp('@Z:A:a_v', qw(@Z::A::a_var2 @Z::Another::a_var2));
+ok_comp('%Z:A:a_v', qw(%Z::A::a_var3 %Z::Another::a_var3));
+ok_comp('%z:a:a_v', qw(%Z::A::a_var3 %Z::Another::a_var3));
+ok_comp('%z:a:a_', qw(%Z::A::a_var3 %Z::Another::a_var3));
+ok_comp('%z:a:a', qw(%Z::A::a_var3 %Z::Another::a_var3));
+ok_comp('Z:A:a_v');
+ok_comp('Z:A:a', qw(Z::A::a_nother_function Z::Another::a_nother_function
+ Z::A::a_function Z::Another::a_function));
+ok_comp('z:a:a', qw(Z::A::a_nother_function Z::Another::a_nother_function
+ Z::A::a_function Z::Another::a_function));
+ok_comp('zaa', qw(Z::A::a_nother_function Z::Another::a_nother_function
+ Z::A::a_function Z::Another::a_function));
+ok_comp('za', qw(Z::A:: Z::Another::));
+
diff --git a/t/50expect.t b/t/50expect.t
index 91955e2..4753141 100644
--- a/t/50expect.t
+++ b/t/50expect.t
@@ -15,7 +15,7 @@ use Sepia;
use Sepia::Xref;
expect_run
- command => "$^X -Mblib -MSepia -MSepia::Xref -e 'Sepia::repl(\\*STDIN, \\*STDOUT)'",
+ command => "$^X -Mblib -MSepia -MSepia::Xref -e Sepia::repl",
prompt => [-re => 'main @[^>]*> '],
quit => ',quit';
expect_handle()->log_file('/tmp/b') if $ENV{USER} eq 'seano';
@@ -44,9 +44,8 @@ q!REPL commands (prefixed with ','):
pattern RE.!
if 0;
-expect ",wh Sepia::Xref xref",
-'xref xref_definitions xref_main
-xref_cv xref_exclude xref_object ';
+expect_send ",wh Sepia::Xref xref";
+expect_like qr/xref \s+ xref_definitions \s+ xref_main \s+ xref_cv \s+ xref_exclude \s+ xref_object \s* /x;
expect_send '{ package A; sub a {}; package X; @ISA = qw(A); sub x {} };';
expect ",wh X", '@ISA x', 'package list';
@@ -61,18 +60,41 @@ expect ',lsb', '';
expect_send ',debug 1';
expect_send "do '$Bin/testy.pl';", 'get testy';
-expect 'fib1 10', '=> 55', 'plain fib';
+expect 'fib1 10', '55', 'plain fib';
expect ',br testy.pl:6', "break testy.pl:6 if 1", 'break?';
expect_send 'fib1 10';
expect_like qr|_<$Bin/testy.pl:6>|, 'break in fib';
# XXX AGAIN STUPID EXPECT!
-expect '$n = 3', "\$n = 3\n=> 3", 'munge lexicals';
+expect '$n = 3', "\$n = 3\n3", 'munge lexicals';
expect ',in',
'[3] DB::DB:
$n = \3', 'munged';
expect ',del', '';
-expect ',con', '=> 2', 'return from fib';
+expect ',con', '2', 'return from fib';
expect_send 'fib2 10', 'bad fib';
expect_like qr/_<$Bin\/testy.pl:12>/;
expect_send ',q', 'quit';
+# expect_like qr/_<$Bin\/testy.pl:12>/;
expect_like qr/error: asdf/, 'saw die message';
+
+<<'EOS';
+,help
+,wh Sepia::Xref xref
+{ package A; sub a {}; package X; @ISA = qw(A); sub x {} };
+,wh X
+,me X
+$x = bless {}, X;
+,me $x
+,lsb
+,debug 1
+do 'testy.pl';
+fib1 10
+,br testy.pl:6
+fib1 10
+$n = 3
+,in
+,del
+,con
+fib2 10
+,q
+EOS
--
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