[sepia] 14/63: Imported Debian patch 0.92-1
Hilko Bengen
bengen at moszumanska.debian.org
Sat Aug 8 11:20:33 UTC 2015
This is an automated email from the git hooks/post-receive script.
bengen pushed a commit to branch master
in repository sepia.
commit b98583f1184f924afe78a1e099d576ad76e6ea6e
Author: Hilko Bengen <bengen at debian.org>
Date: Wed Jul 4 16:59:07 2007 +0200
Imported Debian patch 0.92-1
---
._ChangeLog | Bin 0 -> 176 bytes
ChangeLog | 62 ++++
MANIFEST | 8 +-
META.yml | 2 +-
Makefile.PL | 9 +-
README | 7 +
Sepia.html | 584 ++++++++++++++++++++++++++++++++
debian/NOTES | 12 -
debian/changelog | 6 +
debian/control | 4 +-
debian/emacsen-install | 14 +-
debian/emacsen-remove | 12 +-
lib/._Sepia.pm | Bin 0 -> 178 bytes
lib/Sepia.pm | 347 +++++++++----------
lib/Sepia/Debug.pm | 410 +++++++++++++++++++++++
lib/Sepia/Xref.pm | 11 +-
sepia-ido.el | 2 +-
sepia-tree.el | 2 +-
sepia-w3m.el | 2 +-
sepia.el | 892 ++++++++++++++++++++++++++++---------------------
sepia.texi | 705 ++++++++++++++++++++++++++++++++++++++
test.pl => t/01basic.t | 13 +-
t/50expect.t | 78 +++++
t/testy.pl | 18 +
24 files changed, 2584 insertions(+), 616 deletions(-)
diff --git a/._ChangeLog b/._ChangeLog
new file mode 100644
index 0000000..e20148b
Binary files /dev/null and b/._ChangeLog differ
diff --git a/ChangeLog b/ChangeLog
index 27c1ba0..0bd3b48 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,65 @@
+2007-06-09 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * VERSION: 0.92
+ * sepia.el (sepia-shared-map, etc.): fix keymap initialization.
+
+2007-06-06 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * lib/Sepia/Debug.pm: eval in lexical env when in debugger.
+ * t/50expect.t: REPL tests if you have Test::Expect.
+ * lib/Sepia/Debug.pm: use correct level when none given.
+ * lib/Sepia.pm: No longer bring in exporter (why did we?).
+ * sepia.el (sepia-init): always reinitialize sepia-mode-map.
+ * Makefile.PL: require 5.006 for warnings to quiet stupid "make
+ test".
+
+2007-06-05 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * Sepia.html: generate single-page manual instead of split.
+ * VERSION: 0.90
+ * sepia.el: docstring cleanup.
+ * lib/sepia/Debug.pm: misc usability improvements
+
+2007-06-04 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * VERSION 0.90_02
+ * test.pl: disable Module::Info tests to avoid Module::Info bug.
+
+2007-06-02 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * VERSION 0.90_01
+ * Major: replaced comint- with gud-based REPL, use real debugger.
+ * lib/Sepia/Debug.pm: "perl -d" support.
+ * lib/Sepia.pm (repl_shell): new command.
+ * sepia.el (sepia-eval-defun): detect errors, jump to first.
+ (sepia-comint-setup): don't set comint-use-prompt-regexp
+ (sepia-eval-defun,sepia-beginning-of-defun,sepia-end-of-defun): fix
+
+2007-06-01 Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+ * sepia.el (sepia-perldoc-this): don't mess up window
+ configuration when the page isn't found.
+ (sepia-location): use sepia-interactive-arg.
+ (sepia-perl-[np]e-region): fix.
+
+ * lib/Sepia.pm: fix.
+ (print_dumper): switch format based on size.
+
+2007-05-30 Sean O'Rourke <sorourke at cs.ucsd.edu>
+ * sepia.texi: shiny new manual.
+ * lib/Sepia.pm (completions): add special 'VARIABLE' type.
+ (methods): add second $qualified arg.
+ (repl_reload): new function.
+ (sig_warn,repl): override __WARN__ (and __DIE__) cautiously.
+ (repl): nicer warning format.
+
+ * sepia.el (sepia-eval-raw): stopwarn -> STOPWARN.
+ (sepia-load-file): Fix pop-up error buffer.
+ (sepia-lisp-to-perl): fix quoting of strings.
+ Good citizenship:
+ (sepia-mode): make a real major mode.
+ (sepia-scratchpad-mode): ditto.
+
2007-05-29 Sean O'Rourke <sorourke at cs.ucsd.edu>
* lib/sepia/Xref.pm (pp_method_named): warn -> dprint.
diff --git a/MANIFEST b/MANIFEST
index bf6aeba..a697d0c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2,13 +2,19 @@ MANIFEST
ChangeLog
Makefile.PL
README
+Sepia.html
Sepia.jpg
lib/Sepia.pm
lib/Sepia/Xref.pm
+lib/Sepia/Debug.pm
sepia-ido.el
sepia-tree.el
sepia-w3m.el
sepia.el
-test.pl
+sepia.texi
+t/01basic.t
+t/50expect.t
+t/testy.pl
ChangeLog
+
META.yml Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
index 34bf991..9828577 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Sepia
-version: 0.76
+version: 0.92
abstract: Simple Emacs-Perl InterAction
license: perl
generated_by: ExtUtils::MakeMaker version 6.31
diff --git a/Makefile.PL b/Makefile.PL
index 570e785..aa2b0a4 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,4 +1,5 @@
use ExtUtils::MakeMaker;
+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.
@@ -9,11 +10,9 @@ WriteMakefile(
'B::Module::Info' => 0,
'Scalar::Util' => 0,
},
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (AUTHOR => "Sean O'Rourke <seano\@cpan.org>",
- ABSTRACT => 'Simple Emacs-Perl InterAction')
- : ()),
- LICENSE => 'perl'
+ AUTHOR => "Sean O'Rourke <seano\@cpan.org>",
+ ABSTRACT => 'Simple Emacs-Perl InterAction',
+ LICENSE => 'perl',
);
print <<EOS;
diff --git a/README b/README
index d23ad5f..f4895cf 100644
--- a/README
+++ b/README
@@ -241,6 +241,13 @@ some operations, if you don't mind losing completion.
** (Medium) Support user-defined abbrevs in REPL
** (Easy) Clean up Perl side a bit more.
** (Hard) Use module, file, line to filter results (Emacs side)
+** (Medium) Let sepia-next go backward
+ Need to use a ring 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.
* BUGS
** Function definition lines may occasionally all go completely wrong.
Rebuilding the Xref database fixes this.
diff --git a/Sepia.html b/Sepia.html
new file mode 100644
index 0000000..e9af1c0
--- /dev/null
+++ b/Sepia.html
@@ -0,0 +1,584 @@
+<html lang="en">
+<head>
+<title>SEPIA: Simple Emacs Perl Integration</title>
+<meta http-equiv="Content-Type" content="text/html">
+<meta name="description" content="SEPIA: Simple Emacs Perl Integration">
+<meta name="generator" content="makeinfo 4.8">
+<link title="Top" rel="top" href="#Top">
+<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage">
+<meta http-equiv="Content-Style-Type" content="text/css">
+<style type="text/css"><!--
+ pre.display { font-family:inherit }
+ pre.format { font-family:inherit }
+ pre.smalldisplay { font-family:inherit; font-size:smaller }
+ pre.smallformat { font-family:inherit; font-size:smaller }
+ pre.smallexample { font-size:smaller }
+ pre.smalllisp { font-size:smaller }
+ span.sc { font-variant:small-caps }
+ span.roman { font-family:serif; font-weight:normal; }
+ span.sansserif { font-family:sans-serif; font-weight:normal; }
+--></style>
+</head>
+<body>
+<h1 class="settitle">SEPIA: Simple Emacs Perl Integration</h1>
+<a name="Top"></a>
+
+ <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.
+
+<!-- ============================================================ -->
+<p><a name="Introduction"></a>
+
+<h2 class="chapter">1 Introduction</h2>
+
+<p>Sepia is a set of tools for Perl development in Emacs. Its goal is to
+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>
+
+<h3 class="section">1.1 Getting Started</h3>
+
+<p>To install Sepia, its Emacs Lisp files must be in Emacs'
+<code>load-path</code>, and the <samp><span class="file">lib</span></samp> directory must be in Perl's
+<code>@INC</code>. Assuming that Sepia has been unpacked in
+<samp><span class="file">~/sepia</span></samp>, it can be installed by adding the following lines to
+<samp><span class="file">~/.emacs</span></samp>:
+
+<pre class="example"> (add-to-list 'load-path "~/sepia")
+ (setq sepia-perl5lib (list (expand-file-name "~/sepia/lib")))
+ (defalias 'perl-mode 'sepia-mode)
+ (require 'sepia)
+</pre>
+ <p>Then to bring up the interactive Perl prompt, type <kbd>M-x sepia-repl</kbd>.
+
+<p><a name="Philosophy"></a>
+
+<h3 class="section">1.2 Philosophy</h3>
+
+<p>A development environment should support three activities: code
+spelunking, interaction, and customization. Emacs as an environment for
+developing Emacs Lisp thoroughly supports all of them: It has commands
+to visit individual functions' code and documentation, commands to
+evaluate or step through expressions, and an architecture that
+encourages customization in Emacs Lisp. As an environment for Perl,
+however, it is lacking: there is limited interactivity with the Perl
+debugger, and reasonable documentation browsing, but no support for
+navigating, editing, and re-evaluating code. Sepia attempts to remedy
+the situation.
+
+ <p>Modern IDEs also support these three activities, but do so awkwardly.
+Rather than having functions to visit definitions (<kbd>find-function</kbd>)
+and search for functions (<kbd>apropos</kbd>), they clutter the screen with
+class and file trees. Rather than supporting interactive evaluation of
+small pieces of code, they perform background semantic checking on whole
+projects and highlight errors. Rather than allowing minor
+customizations to grow organically into features, they support limited
+configuration files and baroque plug-in APIs. Sepia tries to adhere to
+the apparent Emacs philosophy that rich semantic information should be
+unobtrusive, and that the best way to build working code is to start
+by experimenting with small pieces.
+
+ <p>Language support packages for Emacs vary widely in the degree to which
+they make use of or replace existing Emacs features. Minimal modes
+provide keyword-based syntax highlighting and an unadorned comint buffer
+as an interpreter. Others provide their own specialized equivalents of
+comint, eldoc, completion, and other Emacs features. Sepia takes a
+third approach by trying to do as much as possible with existing Emacs
+features, even when they are not optimal for Perl. For example, it uses
+comint to communicate with the subprocess, eldoc to display
+documentation, and grep to list source locations.
+
+ <p>This approach has three advantages: First, it maximizes the number of
+features that can be supported with limited development time. Second,
+it respects users' settings. A seasoned Emacs user may have changed
+hundreds of settings, so a mode that reimplements features will have to
+support equivalent settings, and will force the user to re-specify them.
+Finally, this approach respects decades of development spent, as Neal
+Stephenson put it, “focused with maniacal intensity on the deceptively
+simple-seeming problem of editing text.” Many non-obvious choices go
+into making a polished interface, and while a reimplementation gets rid
+of accumulated cruft, it must rediscover these hidden trade-offs.
+
+ <p>Anyways, I hope you enjoy using Sepia. Its development style is strange
+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>
+
+<h2 class="chapter">2 Editing</h2>
+
+<p><a name="index-sepia_002dmode-1"></a>
+Sepia's first contribution is a set of commands to explore a Perl
+codebase. These include commands to browse and display documentation,
+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>
+
+<h3 class="section">2.1 Completion</h3>
+
+<p>Sepia implements partial-word completion that communicates with the
+inferior Perl process. For example, `<samp><span class="samp">%S:X:v_u</span></samp>' completes to
+`<samp><span class="samp">%Sepia::Xref::var_use</span></samp>' when Sepia is loaded. This completion only
+operates on functions and global variables known to the Perl
+interpreter, so it works best when code and interpreter are in sync.
+
+ <p>More precisely, completion examines the text before point and tries each
+of the following in turn, using the first successful approach:
+
+ <ol type=1 start=1>
+<li>If the text looks like a method call (e.g. `<samp><span class="samp">$object->f</span></samp>' or
+`<samp><span class="samp">Class->f</span></samp>'), complete on methods.
+
+ <li>If it looks like a variable (e.g. `<samp><span class="samp">%hash</span></samp>' or `<samp><span class="samp">$scalar</span></samp>'),
+complete on variables.
+
+ <li>Complete on modules and functions.
+
+ <li>Otherwise, complete on Perl built-in operators.
+ </ol>
+
+ <p>For each of the first three cases, completions candidates are first
+generated by splitting the text on characters <code>[:_]</code> and matching
+the resulting word parts. For example, `<samp><span class="samp">X:a_b</span></samp>' will complete to
+all symbols matching `<samp><span class="samp">^X[^:]*:+a[^:_]*_b</span></samp>' such as `<samp><span class="samp">Xref::a_bug</span></samp>'
+and `<samp><span class="samp">X::always_bites_me</span></samp>'. If no matches result, the text is
+treated as an acronym. For example, `<samp><span class="samp">dry</span></samp>' will complete to
+`<samp><span class="samp">dont_repeat_yourself</span></samp>'.
+
+ <p>Completion is performed by the following commands:
+ <dl>
+<dt><kbd>M-x sepia-complete-symbol</kbd><dd><a name="index-sepia_002dcomplete_002dsymbol-2"></a>Complete the symbol before point as described above. Note that this
+does not consider lexical scope, and is always case-sensitive,
+independent of <code>completion-ignore-case</code>.
+
+ <br><dt><kbd>TAB</kbd><dt><kbd>M-x sepia-indent-or-complete</kbd><dd><a name="index-sepia_002dindent_002dor_002dcomplete-3"></a>First try to reindent the current line. If its indentation does not
+change, then try to expand an abbrev at point (unless
+<code>sepia-indent-expand-abbrev</code> is <code>nil</code>). If no abbrev is
+expanded, then call <code>sepia-complete-symbol</code>.
+
+ </dl>
+
+<p><a name="Navigation"></a>
+
+<h3 class="section">2.2 Navigation</h3>
+
+<p>Sepia provides several commands for navigating program source. All of
+them rely on information from the inferior Perl process, so it is
+important both that it be running, and that its internal representation
+of the program match the program source. The commands marked (Xref)
+below also rely on a cross-reference database, which must be explicitly
+rebuilt by calling <code>xref-rebuild</code> when the program changes.
+
+ <p>There are two basic kinds of navigation commands. The first kind jumps
+directly to the first matching location when possible, prompting only if
+no such location is found. These commands find only a single location.
+
+<!-- direct-jump commands -->
+<dl>
+<dt><kbd>M-. M-.</kbd><dt><kbd>M-x sepia-dwim</kbd><dd><a name="index-sepia_002ddwim-4"></a>Guess what kind of identifier is at point, and try to do the right
+thing: for a function, find its definition(s); for a variable, find its
+uses; for a module, view its documentation; otherwise, prompt for the
+name of a function to visit. <code>sepia-dwim</code> automatically goes to
+the first function definition or variable use found.
+
+ <br><dt><kbd>M-. l</kbd><dt><kbd>M-x sepia-location</kbd><dd><a name="index-sepia_002dlocation-5"></a>Jump directly to the definition of the function at point, prompting if
+point is not on a known function. If multiple definitions are found,
+choose one arbitrarily. This function is similar to <code>sepia-defs</code>,
+and the two should probably be merged.
+
+ <br><dt><kbd>M-. j</kbd><dt><kbd>M-x sepia-jump-to-symbol</kbd><dd><a name="index-sepia_002djump_002dto_002dsymbol-6"></a>Navigate to a function using “ido” interactive completion. Within
+interactive completion, press <:> to descend into a package,
+<DEL> to ascend to a parent package, and <RET> to go to the
+currently-selected function.
+
+ </dl>
+
+ <p>The second kind of navigation commands always prompts the user – though
+usually with a sensible default value – and finds multiple locations.
+When called with a prefix argument, these commands present their results
+in a <code>grep-mode</code> buffer. When called <em>without</em> a prefix
+argument, they place all results on the found-location ring and jump
+directly to the first. The remaining locations can be cycled through by
+calls to <code>sepia-next</code>.
+
+<!-- prompt-and-go commands -->
+<dl>
+<dt><kbd>M-. f </kbd><var>name</var><kbd> <RET></kbd><dt><kbd>M-x sepia-defs</kbd><dd><a name="index-sepia_002ddefs-7"></a>Find definition(s) of function <var>name</var>.
+
+ <br><dt><kbd>M-. m </kbd><var>name</var><kbd> <RET></kbd><dt><kbd>M-x sepia-module-find </kbd><var>name</var><kbd> <RET></kbd><dd><a name="index-sepia_002dmodule_002dfind-8"></a>Find the source of module <var>name</var>.
+
+ <br><dt><kbd>M-. a </kbd><var>regexp</var><kbd> <RET></kbd><dt><kbd>M-x sepia-apropos </kbd><var>regexp</var><kbd> <RET></kbd><dd><a name="index-sepia_002dapropos-9"></a>Find definitions of all functions whose names match <var>regexp</var>.
+
+ <br><dt><kbd>M-. c </kbd><var>name</var><kbd> <RET></kbd><dt><kbd>M-x sepia-callers </kbd><var>name</var><kbd> <RET></kbd><dd><a name="index-sepia_002dcallers-10"></a>(Xref) Find calls to function <var>name</var>.
+
+ <br><dt><kbd>M-. C </kbd><var>name</var><kbd> <RET></kbd><dt><kbd>M-x sepia-callees </kbd><var>name</var><kbd> <RET></kbd><dd><a name="index-sepia_002dcallees-11"></a>(Xref) Find the definitions of functions called by <var>name</var>.
+
+ <br><dt><kbd>M-. v </kbd><var>name</var><kbd> <RET></kbd><dt><kbd>M-x sepia-var-uses </kbd><var>name</var><kbd> <RET></kbd><dd><a name="index-sepia_002dvar_002duses-12"></a>(Xref) Find uses of the global variable <var>name</var>.
+
+ <br><dt><kbd>M-. V </kbd><var>name</var><kbd> <RET></kbd><dt><kbd>M-x sepia-var-defs </kbd><var>name</var><kbd> <RET></kbd><dd><a name="index-sepia_002dvar_002ddefs-13"></a>(Xref) Find definitions of global variable <var>name</var>. Since Perl's
+global variables are not declared, this is rarely useful
+
+ <!-- XXX: broken, so don't mention it. -->
+<!-- @item M-. A @var{regexp} @key{RET} -->
+<!-- @itemx M-x sepia-var-apropos -->
+<!-- @findex sepia-var-apropos -->
+<!-- Find definitions of all variables whose names match @var{regexp}. Since -->
+<!-- this function does not handle lexical variables, and since Perl's global -->
+<!-- variables are not declared, this is rarely useful. -->
+</dl>
+
+ <p>Finally, there are several other navigation-related commands that do not
+fit into either of the above categories.
+
+<!-- other commands -->
+<dl>
+<dt><kbd>M-,</kbd><dt><kbd>M-x sepia-next</kbd><dd><a name="index-sepia_002dnext-14"></a>Cycle through the definitions found by the previous <M-.> search.
+
+ <br><dt><kbd>M-. r</kbd><dt><kbd>M-x sepia-rebuild</kbd><dd><a name="index-sepia_002drebuild-15"></a>Rebuild the cross-reference database by walking the op-tree and
+stashes.
+
+ <br><dt><kbd>M-. t</kbd><dt><kbd>M-x find-tag</kbd><dd>Execute the <code>find-tag</code> command typically bound to <M-.>.
+
+ </dl>
+
+<p><a name="Documentation"></a>
+
+<h3 class="section">2.3 Documentation</h3>
+
+<p>Sepia can be used to browse installed modules' documentation, to format
+and display the current buffer's POD, and to browse the list of modules
+installed on the system.
+
+ <dl>
+<dt><kbd>M-. d </kbd><var>name</var><kbd> <RET></kbd><dt><kbd>M-x sepia-perldoc-this</kbd><dd><a name="index-sepia_002dperldoc_002dthis-16"></a>View documentation for module <var>name</var> or Perl manual page <var>name</var>.
+
+ <br><dt><kbd>C-c C-d</kbd><dt><kbd>M-x sepia-view-pod</kbd><dd><a name="index-sepia_002dview_002dpod-17"></a>Format and view the current buffer's documentation.
+
+ <br><dt><kbd>sepia-package-list</kbd><dd><a name="index-sepia_002dpackage_002dlist-18"></a>Browse a tree of installed packages. This lists only the top-level
+packages from installed distributions, so if package <code>My::Stuff</code>
+also provides <code>My::Stuff::Details</code>, it will not be displayed. When
+Emacs-w3m is available, each module is linked to its documentation.
+
+ <br><dt><kbd>sepia-module-list</kbd><dd><a name="index-sepia_002dmodule_002dlist-19"></a>Browse a tree of both top-level and internal packages, like
+<code>sepia-package-list</code>.
+
+ </dl>
+
+ <p><a name="index-sepia_002dinstall_002deldoc-20"></a>Sepia also integrates with eldoc (at least in GNU Emacs >= 22).
+Documentation for Perl operators and control structures is taken from
+CPerl mode. Sepia will also display documentation for user-defined
+functions if their POD is formatted in the standard way, with functions
+described in a “=head2” or “=item” entry. To load user
+documentation, visit the relevant file and type <kbd>M-x
+sepia-doc-update</kbd>.
+
+ <p>If <code>Module::CoreList</code> is available, Sepia's eldoc function will
+also display the first version of Perl with which a module was shipped.
+This is intended to give the programmer a sense of when he is creating
+external dependencies.
+
+<!-- ============================================================ -->
+<p><a name="Interactive-Perl"></a>
+
+<h2 class="chapter">3 Interactive Perl</h2>
+
+<p><a name="index-sepia_002drepl-21"></a>Sepia's second main contribution is an interactive interface (REPL) to
+an inferior Perl process. The interface is based on GUD mode, and
+inherits many of its bindings; this chapter discusses only the Sepia
+extensions. To start or switch to the repl, type <kbd>M-x sepia-repl</kbd>.
+As in Sepia mode, <TAB> in the REPL performs partial-word completion
+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>
+
+<h3 class="section">3.1 Shortcuts</h3>
+
+<p>“Shortcuts” are commands handled specially by the REPL rather than
+being evaluated as Perl code. They either communicate with the REPL
+function, or provide a convenient interface to variables in the Sepia
+package. Shortcuts are prefixed by a comma (<,>), and may be
+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>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>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>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
+mostly of interest when working on Sepia itself.
+
+ <br><dt><kbd>shell [</kbd><var>command</var><kbd>]</kbd><dd>Execute shell command <var>command</var>, displaying its standard output and
+standard error.
+
+ <br><dt><kbd>strict [</kbd><var>val</var><kbd>]</kbd><dd>Set evaluation strictness to <var>val</var>, or toggle it if <var>val</var> is not
+given. Note that turning strictness off and on clears the REPL's
+lexical environment.
+
+ <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>.
+
+ </dl>
+
+<p><a name="Debugger"></a>
+
+<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
+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
+and modify lexical variables.
+
+ <p>The debugger has its own set of shortcuts, also prefixed by a comma.
+
+ <dl>
+<dt><kbd>backtrace</kbd><dd>Show a backtrace.
+
+ <br><dt><kbd>break </kbd><var>file</var><kbd>:</kbd><var>line</var><kbd> [</kbd><var>expr</var><kbd>]</kbd><dd>Set a breakpoint in <var>file</var> at <var>line</var>. If <var>expr</var> is
+supplied, stop only if it evaluates to true.
+
+ <br><dt><kbd>down </kbd><var>n</var><dt><kbd>up </kbd><var>n</var><dd>Move the current stack frame up or down by <var>n</var> (or one) frames.
+
+ <br><dt><kbd>inspect [</kbd><var>n</var><kbd>]</kbd><dd>Inspect lexicals in the current frame or frame <var>n</var>, counting upward
+from 1.
+
+ <br><dt><kbd>lsbreak</kbd><dd>List breakpoints.
+
+ <br><dt><kbd>next [</kbd><var>n</var><kbd>]</kbd><dd>Advance <var>n</var> (or one) lines, skipping subroutine calls.
+
+ <br><dt><kbd>quit</kbd><dt><kbd>die</kbd><dt><kbd>warn</kbd><dd>Continue as the program would have executed without debugger
+intervention, dying if the debugger was called from <code>die()</code>.
+
+ <br><dt><kbd>return </kbd><var>expr</var><dd>Continue execution as if <code>die()</code> had returned the value of
+<var>expr</var>, which is evaluated in the global environment.
+
+ <br><dt><kbd>step [</kbd><var>n</var><kbd>]</kbd><dd>Step forward <var>n</var> (or one) lines, descending into subroutines.
+
+ </dl>
+
+<p><a name="Evaluation"></a>
+
+<h3 class="section">3.3 Evaluation</h3>
+
+<p>When interactive Perl is running, Sepia can evaluate regions of code in
+the inferior Perl process. The following commands assume that this
+process has already been started by calling <code>sepia-repl</code>.
+
+ <dl>
+<dt><kbd>C-M-x</kbd><dt><kbd>M-x sepia-eval-defun</kbd><dd><a name="index-sepia_002deval_002ddefun-22"></a>Evaluate the function around point in the inferior Perl process. If it
+contains errors, jump to the location of the first.
+
+ <br><dt><kbd>C-c C-l</kbd><dt><kbd>M-x sepia-load-file</kbd><dd><a name="index-sepia_002dload_002dfile-23"></a>Save the current buffer, then reload its file and if warnings or errors
+occur, display an error buffer. With a prefix argument, also rebuild
+the cross-reference index.
+
+ <br><dt><kbd>C-c e</kbd><dt><kbd>M-x sepia-eval-expression <RET> </kbd><var>expr</var><kbd> <RET></kbd><dd><a name="index-sepia_002deval_002dexpression-24"></a>Evaluate <var>expr</var> in scalar context and echo the result. With a
+prefix argument, evaluate in list context.
+
+ <br><dt><kbd>C-c!</kbd><dt><kbd>sepia-set-cwd</kbd><dd>Set the REPL's working directory to the current buffer's directory.
+
+ </dl>
+
+<p><a name="Mutilation"></a>
+
+<h3 class="section">3.4 Mutilation</h3>
+
+<p>Sepia contains several functions to operate on regions of text using the
+interactive Perl process. These functions can be used like standard
+one-liners (e.g. `<samp><span class="samp">perl -pe ...</span></samp>'), with the advantage that all of
+the functions and variables in the interactive session are available.
+
+ <dl>
+<dt><kbd>M-x sepia-perl-pe-region <RET> </kbd><var>code</var><kbd> <RET></kbd><dd><a name="index-sepia_002dperl_002dpe_002dregion-25"></a>Evaluate <var>code</var> on each line in the region with <code>$_</code> bound to
+the line text, collecting the resulting values of <code>$_</code>. With a
+prefix argument, replace the region with the result.
+
+ <br><dt><kbd>M-x sepia-perl-ne-region <RET> </kbd><var>code</var><kbd> <RET></kbd><dd><a name="index-sepia_002dperl_002dne_002dregion-26"></a>Evaluate <var>code</var> as above, but collect the results instead.
+
+ <br><dt><kbd>M-x sepia-perlize-region <RET> </kbd><var>code</var><kbd> <RET></kbd><dd><a name="index-sepia_002dperlize_002dregion-27"></a>Evaluate <var>code</var> once with <code>$_</code> bound to the entire region,
+collecting the final value of <code>$_</code>. With a prefix argument,
+replace the region.
+
+ </dl>
+
+<p><a name="Scratchpad"></a>
+
+<h3 class="section">3.5 Scratchpad</h3>
+
+<p><a name="index-sepia_002dscratch-28"></a>Sepia also supports a scratchpad, another form of interaction inspired
+by Emacs' <code>*scratch*</code> buffer. To create or switch to the
+scratchpad, type <kbd>M-x sepia-scratch</kbd>. Scratchpad mode is exactly
+like Sepia mode, except <C-j> evaluates the current line and prints
+the result on the next line.
+
+<!-- ============================================================ -->
+<p><a name="Customization"></a>
+
+<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.
+
+<p><a name="Emacs-Variables"></a>
+
+<h3 class="section">4.1 Emacs Variables</h3>
+
+ <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
+the former requires evaluation of <code>$x</code>, this can be disabled.
+Default: <code>T</code>.
+
+ <br><dt><kbd>sepia-eval-defun-include-decls</kbd><dd>If non-<code>nil</code>, attempt to generate a declaration list for
+<code>sepia-eval-defun</code>. This is necessary when evaluating some code,
+such as that calling functions without parentheses, because the presence
+of declarations affects the parsing of barewords. Default: <code>T</code>.
+
+ <br><dt><kbd>sepia-indent-expand-abbrev</kbd><dd>If non-<code>nil</code>, <code>sepia-indent-or-complete</code> will, if
+reindentation does not change the current line, expand an abbreviation
+before point rather than performing completion. Only if no abbreviation
+is found will it perform completion. Default: <code>T</code>.
+
+ <br><dt><kbd>sepia-module-list-function</kbd><dd>The function to view a tree of installed modules. Default:
+<code>w3m-find-file</code> if Emacs-w3m is installed, or
+<code>browse-url-of-buffer</code> otherwise.
+
+ <br><dt><kbd>sepia-perldoc-function</kbd><dd>The function called to view installed modules' documentation. Default:
+<code>w3m-perldoc</code> if Emacs-w3m is installed, or <code>cperl-perldoc</code>
+otherwise.
+
+ <br><dt><kbd>sepia-perl5lib</kbd><dd>A list of directories to include in <code>PERL5LIB</code> when starting
+interactive Perl. Default: <code>nil</code>.
+
+ <br><dt><kbd>sepia-prefix-key</kbd><dd>The prefix to use for for functions in <code>sepia-keymap</code>. Default:
+<M-.>.
+
+ <br><dt><kbd>sepia-program-name</kbd><dd>The Perl program name for interactive Perl. Default: “perl”.
+
+ <br><dt><kbd>sepia-use-completion</kbd><dd>If non-<code>nil</code>, various Sepia functions will generate completion
+candidates from interactive Perl when called interactively. This may be
+slow or undesirable in some situations. Default: <code>T</code>.
+
+ <br><dt><kbd>sepia-view-pod-function</kbd><dd>The function called to view the current buffer's documentation.
+Default: <code>sepia-w3m-view-pod</code> if Emacs-w3m is available, or
+<code>sepia-perldoc-buffer</code> otherwise.
+
+</dl>
+
+<p><a name="Perl-Variables"></a>
+
+<h3 class="section">4.2 Perl Variables</h3>
+
+<p>The following variables in the Sepia package control various aspects of
+interactive evaluation.
+
+ <dl>
+<dt><code>$PACKAGE</code><dd>The package in which user input is evaluated, determined automatically
+when code is evaluated from a buffer. Default: <code>main</code>.
+
+ <br><dt><code>$PRINTER</code><dd>The function called to format interactive output, normally set with the
+<code>printer</code> shortcut.
+
+ <br><dt><code>$PRINT_PRETTY</code><dd>If true, format some values nicely independent of the value of
+<code>$PRINTER</code>. Currently, this means columnating lists of simple
+scalars. Default: true.
+
+ <br><dt><code>$PS1</code><dd>The trailing end of the prompt string, which should end with “> ”.
+Default: <code>"> "</code>.
+
+ <br><dt><code>$STOPDIE</code><dd>If true, calls to <code>die</code> from interactive code will invoke the Sepia
+debugger. Default: true.
+
+ <br><dt><code>$STOPWARN</code><dd>If true, calls to <code>warn</code> from interactive code will invoke the
+Sepia debugger. Default: false.
+
+ <br><dt><code>$WANTARRAY</code><dd>If true, evaluate interactive expressions in list context. Default: true.
+
+ </dl>
+
+<!-- ============================================================ -->
+<p><a name="Internals"></a>
+
+<h2 class="chapter">5 Internals</h2>
+
+<p>Many things remain unexplained except by the code itself, and some
+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>
+
+<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.
+
+ <p>I would also like to thank the authors of Emacs-w3m, SLIME, ido, and
+B::Xref for the code I stole.
+
+<!-- ============================================================ -->
+<p><a name="Function-Index"></a>
+
+<h2 class="unnumbered">Function Index</h2>
+
+<ul class="index-fn" compact>
+<li><a href="#index-sepia_002dapropos-9"><code>sepia-apropos</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dcallees-11"><code>sepia-callees</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dcallers-10"><code>sepia-callers</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dcomplete_002dsymbol-2"><code>sepia-complete-symbol</code></a>: <a href="#Completion">Completion</a></li>
+<li><a href="#index-sepia_002ddefs-7"><code>sepia-defs</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002ddwim-4"><code>sepia-dwim</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002deval_002ddefun-22"><code>sepia-eval-defun</code></a>: <a href="#Evaluation">Evaluation</a></li>
+<li><a href="#index-sepia_002deval_002dexpression-24"><code>sepia-eval-expression</code></a>: <a href="#Evaluation">Evaluation</a></li>
+<li><a href="#index-sepia_002dindent_002dor_002dcomplete-3"><code>sepia-indent-or-complete</code></a>: <a href="#Completion">Completion</a></li>
+<li><a href="#index-sepia_002dinstall_002deldoc-20"><code>sepia-install-eldoc</code></a>: <a href="#Documentation">Documentation</a></li>
+<li><a href="#index-sepia_002djump_002dto_002dsymbol-6"><code>sepia-jump-to-symbol</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dload_002dfile-23"><code>sepia-load-file</code></a>: <a href="#Evaluation">Evaluation</a></li>
+<li><a href="#index-sepia_002dlocation-5"><code>sepia-location</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dmode-1"><code>sepia-mode</code></a>: <a href="#Editing">Editing</a></li>
+<li><a href="#index-sepia_002dmodule_002dfind-8"><code>sepia-module-find</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dmodule_002dlist-19"><code>sepia-module-list</code></a>: <a href="#Documentation">Documentation</a></li>
+<li><a href="#index-sepia_002dnext-14"><code>sepia-next</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dpackage_002dlist-18"><code>sepia-package-list</code></a>: <a href="#Documentation">Documentation</a></li>
+<li><a href="#index-sepia_002dperl_002dne_002dregion-26"><code>sepia-perl-ne-region</code></a>: <a href="#Mutilation">Mutilation</a></li>
+<li><a href="#index-sepia_002dperl_002dpe_002dregion-25"><code>sepia-perl-pe-region</code></a>: <a href="#Mutilation">Mutilation</a></li>
+<li><a href="#index-sepia_002dperldoc_002dthis-16"><code>sepia-perldoc-this</code></a>: <a href="#Documentation">Documentation</a></li>
+<li><a href="#index-sepia_002dperlize_002dregion-27"><code>sepia-perlize-region</code></a>: <a href="#Mutilation">Mutilation</a></li>
+<li><a href="#index-sepia_002drebuild-15"><code>sepia-rebuild</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002drepl-21"><code>sepia-repl</code></a>: <a href="#Interactive-Perl">Interactive Perl</a></li>
+<li><a href="#index-sepia_002dscratch-28"><code>sepia-scratch</code></a>: <a href="#Scratchpad">Scratchpad</a></li>
+<li><a href="#index-sepia_002dvar_002ddefs-13"><code>sepia-var-defs</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dvar_002duses-12"><code>sepia-var-uses</code></a>: <a href="#Navigation">Navigation</a></li>
+<li><a href="#index-sepia_002dview_002dpod-17"><code>sepia-view-pod</code></a>: <a href="#Documentation">Documentation</a></li>
+</ul></body></html>
+
diff --git a/debian/NOTES b/debian/NOTES
deleted file mode 100644
index 07f3b42..0000000
--- a/debian/NOTES
+++ /dev/null
@@ -1,12 +0,0 @@
--*- org -*-
-* Dependencies:
- tree-eidget.el (included in .deb)
- ido.el: emacs-goodies, included in emacs22
- mule-ucs:
- semi
- flim
- apel
-
- semi | emacs-snapshot,
- flim | emacs-snapshot,
- apel | emacs-snapshot,
diff --git a/debian/changelog b/debian/changelog
index fb98eca..0c726a1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+sepia (0.92-1) unstable; urgency=low
+
+ * New upstream release (Closes:
+
+ -- Hilko Bengen <bengen at debian.org> Wed, 04 Jul 2007 16:59:07 +0200
+
sepia (0.76-1) unstable; urgency=low
* New upstream release
diff --git a/debian/control b/debian/control
index c5dfcc1..bcefee4 100644
--- a/debian/control
+++ b/debian/control
@@ -10,8 +10,8 @@ Package: sepia
Architecture: all
Depends: ${perl:Depends},
libpadwalker-perl (>= 1.0), libmodule-info-perl, libsub-uplevel-perl,
- emacs21 | emacs-snapshot,
- emacs-goodies-el | emacs-snapshot
+ emacs21 | emacs22,
+ emacs-goodies-el | emacs22
Recommends: w3m-el, perl-doc
Description: Simple Emacs-Perl InterAction
Sepia is a set of features to make Emacs a better tool for Perl
diff --git a/debian/emacsen-install b/debian/emacsen-install
index 8a3a6aa..108d016 100644
--- a/debian/emacsen-install
+++ b/debian/emacsen-install
@@ -9,14 +9,16 @@ FLAVOR=$1
PACKAGE=sepia
case ${FLAVOR} in
- emacs22);;
- emacs21);;
- emacs-snapshot);;
- *) exit 0;;
+ emacs21|emacs22)
+ echo install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR}
+ ;;
+ *)
+ echo install/${PACKAGE}: Ignoring emacsen flavor ${FLAVOR}
+
+ exit 0
+ ;;
esac
-echo install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR}
-
#FLAVORTEST=`echo $FLAVOR | cut -c-6`
#if [ ${FLAVORTEST} = xemacs ] ; then
# SITEFLAG="-no-site-file"
diff --git a/debian/emacsen-remove b/debian/emacsen-remove
index 78fcafb..6773e3e 100644
--- a/debian/emacsen-remove
+++ b/debian/emacsen-remove
@@ -5,10 +5,14 @@ FLAVOR=$1
PACKAGE=sepia
case ${FLAVOR} in
- emacs22);;
- emacs21);;
- emacs-snapshot);;
- *) exit 0;;
+ emacs21|emacs22)
+ echo install/${PACKAGE}: Handling remove for emacsen flavor ${FLAVOR}
+ ;;
+ *)
+ echo install/${PACKAGE}: Ignoring emacsen flavor ${FLAVOR}
+
+ exit 0
+ ;;
esac
if test -x /usr/sbin/install-info-altdir; then
diff --git a/lib/._Sepia.pm b/lib/._Sepia.pm
new file mode 100644
index 0000000..45df49c
Binary files /dev/null and b/lib/._Sepia.pm differ
diff --git a/lib/Sepia.pm b/lib/Sepia.pm
index 94eaef3..ac0bb91 100644
--- a/lib/Sepia.pm
+++ b/lib/Sepia.pm
@@ -9,34 +9,31 @@ Sepia - Simple Emacs-Perl Interface
From inside Emacs:
M-x load-library RET sepia RET
- M-x sepia-init RET
+ M-x sepia-repl RET
-At the prompt in the C<*perl-interaction*> buffer:
+At the prompt in the C<*sepia-repl*> buffer:
main @> ,help
-=cut
+For more information, please see F<sepia/index.html>.
-$VERSION = '0.76';
- at ISA = qw(Exporter);
+=cut
-require Exporter;
+$VERSION = '0.92';
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 Carp;
-use B;
-use vars qw($PS1 $dies $STOPDIE $STOPWARN %REPL %RK %REPL_DOC
- $PACKAGE $WANTARRAY $PRINTER $STRICT $PRINT_PRETTY);
+use vars qw($PS1 %REPL %RK %REPL_DOC
+ $REPL_LEVEL $REPL_IN $REPL_OUT
+ $PACKAGE $WANTARRAY $PRINTER $STRICT $PRINT_PRETTY
+ $ISEVAL);
BEGIN {
- eval { require PadWalker; import PadWalker qw(peek_my) };
- if ($@) {
- *peek_my = sub { +{ } };
- }
eval { require Lexical::Persistence; import Lexical::Persistence };
if ($@) {
*repl_strict = sub {
@@ -56,9 +53,9 @@ BEGIN {
}
eval { require Module::CoreList };
if ($@) {
- *core_version = sub { '???' };
+ *Sepia::core_version = sub { '???' };
} else {
- *core_version = sub { Module::CoreList->first_release(@_) };
+ *Sepia::core_version = sub { Module::CoreList->first_release(@_) };
}
}
@@ -67,7 +64,9 @@ BEGIN {
Sepia is a set of features to make Emacs a better tool for Perl
development. This package contains the Perl side of the
implementation, including all user-serviceable parts (for the
-cross-referencing facility see L<Sepia::Xref>).
+cross-referencing facility see L<Sepia::Xref>). This document is
+aimed as Sepia developers; for user documentation, see
+L<sepia/index.html>.
Though not intended to be used independent of the Emacs interface, the
Sepia module's functionality can be used through a rough procedural
@@ -135,6 +134,10 @@ BEGIN {
%sigil = qw(ARRAY @ SCALAR $ HASH %);
}
+## XXX: autovivification gives us problems here sometimes. Specifically:
+## defined *FOO{HASH} # => ''
+## defined %FOO # => ''
+## defined *FOO{HASH} # => 1
sub completions
{
no strict;
@@ -203,24 +206,19 @@ sub completions
sub method_completions
{
- my ($expr, $fn, $eval) = @_;
- $expr =~ s/^\s+//;
- $expr =~ s/\s+$//;
- $eval ||= 'eval';
+ my ($x, $fn, $eval) = @_;
+ $x =~ s/^\s+//;
+ $x =~ s/\s+$//;
+ $eval ||= 'CORE::eval';
no strict;
- my $x;
- if ($x =~ /^\$/) {
- $x = $eval->("ref($expr)");
- } elsif ($eval->('defined(%{'.$expr.'::})')) {
- $x = $expr;
- } else {
- return;
- }
+ return unless ($x =~ /^\$/ && ($x = $eval->("ref($x)")))
+ || $eval->('defined(%{'.$x.'::})');
unless ($@) {
my $re = _apropos_re $fn;
- print STDERR "$x / $re\n";
+ ## Filter out overload methods "(..."
return sort { $a cmp $b } map { s/.*:://; $_ }
- grep { defined *{$_}{CODE} && /::$re/ } methods($x, 1);
+ grep { defined *{$_}{CODE} && /::$re/ && !/\(/ }
+ methods($x, 1);
}
}
@@ -361,7 +359,7 @@ sub mod_decls
my $sn = $_;
my $proto = prototype(\&{"$pack\::$sn"});
$proto = defined($proto) ? "($proto)" : '';
- "sub $sn $proto;\n";
+ "sub $sn $proto;";
} mod_subs($pack);
return wantarray ? @ret : join '', @ret;
}
@@ -501,9 +499,10 @@ sub tolisp($)
} elsif (looks_like_number $thing) {
''.(0+$thing);
} else {
- ## XXX Elisp and perl probably have slightly different
- ## escaping conventions, but oh well...
- '"'.quotemeta($thing).'"';
+ ## XXX Elisp and perl have slightly different
+ ## escaping conventions, so we do this crap instead.
+ $thing =~ s/["\\]/\\$1/g;
+ qq{"$thing"};
}
} elsif ($t eq 'GLOB') {
(my $name = $$thing) =~ s/\*main:://;
@@ -522,9 +521,9 @@ sub tolisp($)
}
}
-=head2 C<printer(\@res [, $iseval])>
+=head2 C<printer(\@res, $wantarray)>
-Print C<@res> appropriately on the current filehandle. If C<$iseval>
+Print C<@res> appropriately on the current filehandle. If C<$ISEVAL>
is true, use terse format. Otherwise, use human-readable format,
which can use either L<Data::Dumper>, L<YAML>, or L<Data::Dump>.
@@ -532,15 +531,28 @@ which can use either L<Data::Dumper>, L<YAML>, or L<Data::Dump>.
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 {
- local $_ = Data::Dumper::Dumper(@res > 1 ? \@res : $res[0]);
+ $_ = Data::Dumper::Dumper($thing);
s/^\$VAR1 = //;
s/;$//;
- $_;
};
+ if (length $_ > ($ENV{COLUMNS} || 80)) {
+ $Data::Dumper::Indent = 2;
+ eval {
+ $_ = Data::Dumper::Dumper($thing);
+ s/\A\$VAR1 = //;
+ s/;\Z//;
+ };
+ s/\A\$VAR1 = //;
+ s/;\Z//;
+ }
+ $_;
}
sub print_plain
@@ -567,7 +579,7 @@ sub print_dump
if ($@) {
print_dumper;
} else {
- Data::Dump::dump;
+ Data::Dump::dump(\@res);
}
}
@@ -575,23 +587,24 @@ sub printer
{
no strict;
local *res = shift;
- my ($iseval, $wantarray) = @_;
+ my ($wantarray) = @_;
@::__ = @res;
$::__ = @res == 1 ? $res[0] : [@res];
my $str;
- if ($iseval) {
+ if ($ISEVAL) {
$res = "@res";
- } elsif (@res == 1 && (ref $res[0]) =~ /^PDL/) {
+ } elsif (@res == 1 && UNIVERSAL::can($res[0], '()')) {
+ # overloaded?
$res = $res[0];
- } elsif (!$iseval && $PRINT_PRETTY && @res > 1 && grep !ref $_, @res) {
+ } elsif (!$ISEVAL && $PRINT_PRETTY && @res > 1 && !grep ref, @res) {
$res = columnate(sort @res);
print $res;
return;
} else {
$res = $PRINTER->();
}
- if ($iseval) {
- print ';;;', length $res, "\n$::__\n";
+ if ($ISEVAL) {
+ print ';;;', length $res, "\n$res\n";
} else {
print "=> $res\n";
}
@@ -620,15 +633,11 @@ Behavior is controlled in part through the following package-globals:
=item C<$PS1> -- the default prompt
-=item C<$STOPDIE> -- true to enter the inspector on C<die()>
-
-=item C<$STOPWARN> -- true to enter the inspector on C<warn()>
-
=item C<$STRICT> -- whether 'use strict' is applied to input
=item C<$WANTARRAY> -- evaluation context
-=item C<$PRINT_PRETTY> -- format some output nicely (default = 0)
+=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.
@@ -644,13 +653,10 @@ displays arrays of scalars as columns.
BEGIN {
no strict;
$PS1 = "> ";
- $dies = 0;
- $STOPDIE = 1;
- $STOPWARN = 0;
$PACKAGE = 'main';
$WANTARRAY = 1;
$PRINTER = \&Sepia::print_dumper;
- $PRINT_PRETTY = 0;
+ $PRINT_PRETTY = 1;
%REPL = (help => \&Sepia::repl_help,
cd => \&Sepia::repl_chdir,
methods => \&Sepia::repl_methods,
@@ -660,6 +666,9 @@ BEGIN {
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 =>
@@ -677,6 +686,8 @@ EOS
'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 =>
@@ -685,8 +696,9 @@ EOS
who PACKAGE [RE] List variables and subs in PACKAGE matching optional
pattern RE.
EOS
+ reload =>
+ 'reload Reload Sepia.pm and relaunch the REPL.',
);
- %RK = abbrev keys %REPL;
}
sub prompt()
@@ -700,48 +712,12 @@ sub Dump {
};
}
-sub eval_in_env
-{
- my ($expr, $env) = @_;
- local $::ENV = $env;
- my $str = '';
- for (keys %$env) {
- next unless /^([\$\@%])(.+)/;
- $str .= "local *$2 = \$::ENV->{'$_'}; ";
- }
- eval "do { no strict; $str $expr }";
-}
-
-sub debug_upeval
-{
- my ($lev, $exp) = $_[0] =~ /^\s*(\d+)\s+(.*)/;
- print " <= $exp\n";
- (0, eval_in_env($exp, peek_my(0+$lev)));
-}
-
-sub debug_inspect
-{
- local $_ = shift;
- for my $i (split) {
- my $sub = (caller $i)[3];
- next unless $sub;
- my $h = peek_my($i);
- print "[$i] $sub:\n";
- no strict;
- for (sort keys %$h) {
- local @res = $h->{$_};
- print "\t$_ = ", $PRINTER->(), "\n";
- }
- }
- 0;
-}
-
sub repl_help
{
print "REPL commands (prefixed with ','):\n";
for (sort keys %REPL) {
- print " ",
- exists $REPL_DOC{$_} ? "$REPL_DOC{$_}\n": "$_ (undocumented)\n";
+ print " ", exists $REPL_DOC{$_} ? "$REPL_DOC{$_}\n":
+ sprintf("%-18s (undocumented)\n", $_);
}
0;
}
@@ -839,7 +815,7 @@ sub repl_methods
$x =~ s/^\s+//;
$x =~ s/\s+$//;
if ($x =~ /^\$/) {
- $x = repl_eval("ref $x");
+ $x = $REPL{eval}->("ref $x");
return 0 if $@;
}
$re ||= '.?';
@@ -880,35 +856,29 @@ sub repl_quit
1;
}
-sub debug_help
+sub repl_reload
{
- print <<EOS;
-Inspector commands (prefixed with ','):
- ^C Pop one debugger level
- backtrace show backtrace
- inspect N ... inspect lexicals in frame(s) N ...
- eval N EXPR evaluate EXPR in lexical environment of frame N
- return EXPR return EXPR
- die/warn keep on dying/warning
-EOS
- 0;
-}
-
-sub debug_backtrace
-{
- Carp::cluck;0
+ do $INC{'Sepia.pm'};
+ if ($@) {
+ print "Reload failed:\n$@\n";
+ } else {
+ @_ = (select, 0);
+ goto &Sepia::repl;
+ }
}
-sub debug_return
+sub repl_shell
{
- (1, repl_eval(@_));
+ my $cmd = shift;
+ print `$cmd 2>& 1`;
+ return 0;
}
sub repl_eval
{
- my ($buf, $wantarray, $pkg) = @_;
+ my ($buf) = @_;
no strict;
- local $PACKAGE = $pkg || $PACKAGE;
+ # local $PACKAGE = $pkg || $PACKAGE;
if ($STRICT) {
if (!$WANTARRAY) {
$buf = 'scalar($buf)';
@@ -917,7 +887,7 @@ sub repl_eval
$ctx = $ctx ? "my ($ctx);" : '';
$buf = eval "sub { package $PACKAGE; use strict; $ctx $buf }";
if ($@) {
- print STDERR "ERROR\n$@\n";
+ print "ERROR\n$@\n";
return;
}
$STRICT->call($buf);
@@ -931,10 +901,40 @@ sub repl_eval
}
}
+## Collects warnings for REPL
+my @warn;
+
+sub sig_warn
+{
+ push @warn, shift
+}
+
+sub print_warnings
+{
+ if (@warn) {
+ if ($ISEVAL) {
+ my $tmp = "@warn";
+ print ';;;'.length($tmp)."\n$tmp\n";
+ } else {
+ for (@warn) {
+ # s/(.*) at .*/$1/;
+ print "warning: $_\n";
+ }
+ }
+ }
+}
+
sub repl
{
- my ($fh, $level) = @_;
- select((select($fh), $|=1)[0]);
+ if (@_ > 0) {
+ $REPL_IN = $_[0];
+ $REPL_OUT = $_[1];
+ }
+ select $REPL_OUT;
+ $| = 1;
+
+ local $REPL_LEVEL = $REPL_LEVEL + 1;
+
my $in;
my $buf = '';
my $sigged = 0;
@@ -942,45 +942,10 @@ sub repl
my $nextrepl = sub { $sigged = 1; };
local *__;
- my $MSG = "('\\C-c' to exit, ',h' for help)";
- my %dhooks = (
- backtrace => \&Sepia::debug_backtrace,
- inspect => \&Sepia::debug_inspect,
- eval => \&Sepia::debug_upeval,
- return => \&Sepia::debug_return,
- help => \&Sepia::debug_help,
- );
- local *CORE::GLOBAL::die = sub {
- ## Protect us against people doing weird things.
- CORE::die(@_) if $SIG{__DIE__} ne 'DEFAULT';
- my @dieargs = @_;
- if ($STOPDIE) {
- local $dies = $dies+1;
- local $PS1 = "*$dies*> ";
- no strict;
- local %Sepia::REPL = (
- %dhooks, die => sub { local $Sepia::STOPDIE=0; die @dieargs });
- local %Sepia::RK = abbrev keys %Sepia::REPL;
- print "@_\nDied $MSG\n\tin ".caller;
- return Sepia::repl($fh, 1);
- }
- CORE::die(@_);
- };
-
- local *CORE::GLOBAL::warn = sub {
- if ($STOPWARN) {
- local $dies = $dies+1;
- local $PS1 = "*$dies*> ";
- no strict;
- local %Sepia::REPL = (
- %dhooks, warn => sub { local $Sepia::STOPWARN=0; warn @dieargs });
- local %Sepia::RK = abbrev keys %Sepia::REPL;
- print "@_\nWarned $MSG\n";
- return Sepia::repl($fh, 1);
- }
- CORE::warn(@_);
- };
- print <<EOS if $dies == 0;
+ local *CORE::GLOBAL::die = \&Sepia::Debug::die;
+ local *CORE::GLOBAL::warn = \&Sepia::Debug::warn;
+ 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
@@ -988,7 +953,7 @@ EOS
my @sigs = qw(INT TERM PIPE ALRM);
local @SIG{@sigs};
$SIG{$_} = $nextrepl for @sigs;
- repl: while (my $in = <$fh>) {
+ repl: while (defined(my $in = <$REPL_IN>)) {
if ($sigged) {
$buf = '';
$sigged = 0;
@@ -997,20 +962,23 @@ EOS
}
$buf .= $in;
$buf =~ s/^\s*//;
- my $iseval;
+ local $ISEVAL;
if ($buf =~ /^<<(\d+)\n(.*)/) {
- $iseval = 1;
+ $ISEVAL = 1;
my $len = $1;
my $tmp;
$buf = $2;
- while ($len && defined($tmp = read $fh, $buf, $len, length $buf)) {
+ while ($len && defined($tmp = read $REPL_IN, $buf, $len, length $buf)) {
$len -= $tmp;
}
}
- my (@res, @warn);
- local $SIG{__WARN__} = sub {
- push @warn, shift;
- };
+ my (@res);
+ ## Only install a magic handler if no one else is playing.
+ local $SIG{__WARN__} = $SIG{__WARN__};
+ @warn = ();
+ unless ($SIG{__WARN__}) {
+ $SIG{__WARN__} = 'Sepia::sig_warn';
+ }
if ($buf =~ /^,(\S+)\s*(.*)/s) {
## Inspector shortcuts
my $short = $1;
@@ -1036,10 +1004,16 @@ EOS
}
} else {
## Ordinary eval
- @res = repl_eval $buf, wantarray;
-
+ @res = $REPL{eval}->($buf);
if ($@) {
- if ($@ =~ /at EOF$/m) {
+ if ($ISEVAL) {
+ ## Always return results for an eval request
+ Sepia::printer \@res, wantarray;
+ Sepia::printer [$@], wantarray;
+ # print_warnings $ISEVAL;
+ $buf = '';
+ print prompt;
+ } elsif ($@ =~ /at EOF$/m) {
## Possibly-incomplete line
if ($in eq "\n") {
print "Error:\n$@\n*** cancel ***\n", prompt;
@@ -1047,35 +1021,30 @@ EOS
} else {
print ">> ";
}
- next repl;
} else {
- warn $@;
+ print_warnings;
+ # $@ =~ s/(.*) at eval .*/$1/;
+ print "error: $@\n";
+ print prompt;
$buf = '';
- Sepia::printer \@res, $iseval, wantarray if $iseval;
}
+ next repl;
}
}
if ($buf !~ /;$/ && $buf !~ /^,/) {
## Be quiet if it ends with a semicolon, or if we
## executed a shortcut.
- Sepia::printer \@res, $iseval, wantarray;
+ Sepia::printer \@res, wantarray;
}
$buf = '';
- if (@warn) {
- if ($iseval) {
- my $tmp = "@warn";
- print ';;;'.length($tmp)."\n$tmp\n";
- } else {
- print "@warn\n";
- }
- }
+ print_warnings;
print prompt;
}
}
sub perl_eval
{
- tolisp(repl_eval(shift));
+ tolisp($REPL{eval}->(shift));
}
=head2 C<$status = html_module_list($file [, $prefix])>
@@ -1098,31 +1067,31 @@ sub html_module_list
my $inst = inst();
return unless $inst;
return unless open OUT, ">$file";
- print "<html><body><ul>";
+ print OUT "<html><body><ul>";
my $pfx = '';
my %ns;
for (package_list) {
push @{$ns{$1}}, $_ if /^([^:]+)/;
}
for (sort keys %ns) {
- print qq{<li><b>$_</b><ul>} if @{$ns{$_}} > 1;
+ print OUT qq{<li><b>$_</b><ul>} if @{$ns{$_}} > 1;
for (sort @{$ns{$_}}) {
my @fs = map {
s/.*man.\///; s|/|::|g; s/\..?pm//; $_
} grep /\.\dpm$/, sort $inst->files($_);
if (@fs == 1) {
- print qq{<li><a href="$base$fs[0]">$fs[0]</a>};
+ print OUT qq{<li><a href="$base$fs[0]">$fs[0]</a>};
} else {
- print qq{<li>$_<ul>};
+ print OUT qq{<li>$_<ul>};
for (@fs) {
- print qq{<li><a href="$base$_">$_</a>};
+ print OUT qq{<li><a href="$base$_">$_</a>};
}
- print '</ul>';
+ print OUT '</ul>';
}
}
- print qq{</ul>} if @{$ns{$_}} > 1;
+ print OUT qq{</ul>} if @{$ns{$_}} > 1;
}
- print "</ul></body></html>\n";
+ print OUT "</ul></body></html>\n";
close OUT;
1;
}
diff --git a/lib/Sepia/Debug.pm b/lib/Sepia/Debug.pm
new file mode 100644
index 0000000..fb67720
--- /dev/null
+++ b/lib/Sepia/Debug.pm
@@ -0,0 +1,410 @@
+package Sepia::Debug;
+# use Sepia;
+require Carp;
+use Text::Abbrev;
+use strict;
+use vars qw($pack $file $line $sub $level
+ $STOPDIE $STOPWARN);
+
+BEGIN {
+ ## Just leave it on -- with $DB::trace = 0, there doesn't seem
+ ## to be a perforamnce penalty!
+ $^P = 0x303;
+ $STOPDIE = 1;
+ $STOPWARN = 0;
+
+ eval { require PadWalker; import PadWalker qw(peek_my) };
+ if ($@) {
+ *peek_my = sub { +{ } };
+ }
+}
+
+# set debugging level
+sub repl_debug
+{
+ debug(@_);
+ 0;
+}
+
+sub repl_backtrace
+{
+ for (my $i = 0; ; ++$i) {
+ my ($pack, $file, $line, $sub) = caller($i);
+ 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}->(@_));
+}
+
+sub repl_lsbreak
+{
+ no strict 'refs';
+ for my $file (sort grep /^_</ && defined %{"::$_"}, keys %::) {
+ my ($name) = $file =~ /^_<(.*)/;
+ my @pts = keys %{"::$file"};
+ next unless @pts;
+ print "$name:\n";
+ for (sort { $a <=> $b } @pts) {
+ print "\t$_\t${$file}{$_}\n"
+ }
+ }
+}
+
+# evaluate EXPR in environment ENV
+sub eval_in_env
+{
+ my ($expr, $env) = @_;
+ local $Sepia::ENV = $env;
+ my $str = '';
+ for (keys %$env) {
+ next unless /^([\$\@%])(.+)/;
+ $str .= "local *$2 = \$Sepia::ENV->{'$_'}; ";
+ }
+ eval "do { no strict; $str $expr }";
+}
+
+sub tie_class
+{
+ my $sig = substr shift, 0, 1;
+ return $sig eq '$' ? 'Tie::StdScalar'
+ : $sig eq '@' ? 'Tie::StdArray'
+ : $sig eq '%' ? 'Tie::StdHash'
+ : 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
+{
+ my ($expr, $env, $fn) = @_;
+ local $Sepia::ENV = $env;
+ my @vars = grep /^([\$\@%])(.+)/, keys %$env;
+ my $body = 'sub { my ('.join(',', @vars).');';
+ for (@vars) {
+ $body .= "Devel::LexAlias::lexalias(\$Sepia::ENV, '$_', \\$_);"
+ }
+ $body .= "$expr }";
+ print STDERR "---\n$body\n---\n";
+ $body = eval $body;
+ $@ || $body->();
+}
+
+# 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));
+}
+
+# inspect lexicals at level N, or current level
+sub repl_inspect
+{
+ my $i = shift;
+ if ($i =~ /\d/) {
+ $i = 0+$i;
+ } else {
+ $i = $level + 3;
+ }
+ my $sub = (caller $i)[3];
+ if ($sub) {
+ my $h = peek_my($i+1);
+ print "[$i] $sub:\n";
+ for (sort keys %$h) {
+ local @Sepia::res = $h->{$_};
+ print "\t$_ = ", $Sepia::PRINTER->(), "\n";
+ }
+ }
+ 0;
+}
+
+sub debug
+{
+ my $new = Sepia::as_boolean(shift, $DB::trace);
+ return if $new == $DB::trace;
+ if ($new) {
+ # $^P = 0x2 | 0x10 | 0x100 | 0x200;
+ # *DB::DB = \&repl;
+ $DB::trace = 1;
+ print "debug ON\n";
+ } else {
+ $DB::trace = 0;
+ print "debug OFF\n";
+ }
+}
+
+sub breakpoint_file
+{
+ my ($file) = @_;
+ return \%{$main::{"_<$file"}} if exists $main::{"_<$file"};
+ if ($file !~ /^\//) {
+ ($file) = grep /^_<.*\/\Q$file\E$/, keys %main::;
+ return \%{$main::{$file}} if $file;
+ }
+ return undef;
+}
+
+sub breakpoint
+{
+ my ($file, $line, $cond) = @_;
+ my $h = breakpoint_file $file;
+ if (defined $h) {
+ $h->{$line} = $cond || 1;
+ return $cond ? "$file\:$line if $cond" : "$file\:$line";
+ }
+ return undef;
+}
+
+sub repl_break
+{
+ my $arg = shift;
+ $arg =~ s/^\s+//;
+ $arg =~ s/\s+$//;
+ my ($f, $l, $cond) = $arg =~ /^(.+?):(\d+)\s*(.*)/;
+ $cond ||= 1;
+ $f ||= $file;
+ $l ||= $line;
+ print "break ", breakpoint($f, $l, $cond), "\n";
+ 0;
+}
+
+sub update_location
+{
+ # XXX: magic numberage.
+ ($pack, $file, $line, $sub) = caller($level + shift);
+}
+
+sub show_location
+{
+ print "_<$file:$line>\n" if defined $file && defined $line;
+}
+
+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
+{
+ my ($f, $l) = split /:/, shift;
+ $f ||= $file;
+ $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);
+ %Sepia::RK = abbrev keys %Sepia::REPL;
+}
+
+my %REPL = (
+ up => sub {
+ $level += shift || 1;
+ update_location(4);
+ show_location;
+ 0
+ },
+ down => sub {
+ $level -= shift || 1;
+ $level = 0 if $level < 0;
+ update_location(4);
+ show_location;
+ 0
+ },
+
+ continue => sub {
+ $level = 0;
+ $DB::single = 0; 1
+ },
+
+ 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',
+ );
+
+sub repl
+{
+ show_location;
+
+ local %Sepia::REPL = (%Sepia::REPL, %REPL, @_);
+ local %Sepia::REPL_DOC = (%Sepia::REPL_DOC, %REPL_DOC);
+ local %Sepia::RK = abbrev keys %Sepia::REPL;
+ # local $Sepia::REPL_LEVEL = $Sepia::REPL_LEVEL + 1;
+ local $Sepia::PS1 = "*$Sepia::REPL_LEVEL*> ";
+ Sepia::repl();
+}
+
+sub DB::DB
+{
+ return if $Sepia::ISEVAL;
+ local $level = 0;
+ local ($pack, $file, $line, $sub) = caller($level);
+ ## Don't do anything if we're inside an eval request, even if in
+ ## single-step mode.
+ return unless $DB::single || exists $main::{"_<$file"}{$line};
+ if ($DB::single) {
+ return unless --$DB::single == 0;
+ } else {
+ my $cond = $main::{"_<$file"}{$line};
+ if ($cond eq 'next') {
+ delete $main::{"_<$file"}{$line};
+ } else {
+ return unless eval $cond;
+ }
+ }
+ repl();
+}
+
+my $MSG = "('\\C-c' to exit, ',h' for help)";
+
+sub die
+{
+ ## Protect us against people doing weird things.
+ if ($STOPDIE && !$SIG{__DIE__}) {
+ my @dieargs = @_;
+ local $level = 0;
+ local ($pack, $file, $line, $sub) = caller($level);
+ print "@_\n\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 });
+ $DB::trace = $trace;
+ } else {
+ CORE::die(Carp::shortmess @_);
+ }
+}
+
+sub warn
+{
+ ## Again, this is above our pay grade:
+ if ($STOPWARN && $SIG{__WARN__} eq 'Sepia::sig_warn') {
+ my @dieargs = @_;
+ my $trace = $DB::trace;
+ $DB::trace = 1;
+ local $level = 0;
+ 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 });
+ $DB::trace = $trace;
+ } else {
+ ## Avoid showing up in location information.
+ CORE::warn(Carp::shortmess @_);
+ }
+}
+
+1;
diff --git a/lib/Sepia/Xref.pm b/lib/Sepia/Xref.pm
index b17fc43..737ce8f 100644
--- a/lib/Sepia/Xref.pm
+++ b/lib/Sepia/Xref.pm
@@ -29,6 +29,8 @@ most of its code.
=cut
+# use Sepia '_apropos_re';
+require Sepia;
BEGIN { *_apropos_re = *Sepia::_apropos_re; }
$VERSION = '0.65';
@@ -38,8 +40,8 @@ use Cwd 'abs_path';
use B qw(peekop class comppadlist main_start svref_2object walksymtable
OPpLVAL_INTRO SVf_POK OPpOUR_INTRO OPf_MOD OPpDEREF_HV OPpDEREF_AV
cstring);
-# use Sepia '_apropos_re';
-require Sepia;
+# stupid warnings...
+no warnings 'uninitialized';
=head2 Variables
@@ -130,6 +132,7 @@ sub guess_module_file {
return undef if $ofile =~ /Exporter\.pm$/;
# Try for standard translation in %INC:
(my $fn = $pack) =~ s/::/\//g;
+ return unless $fn; # stupid warnings...
if (exists $INC{"$fn.pm"}) {
return $INC{"$fn.pm"};
}
@@ -201,7 +204,6 @@ sub process {
my ($spack, $sname) = split_name($subname);
$call{$name}{$pack}{$subname} = 1;
-
$callby{$sname}{$spack}{"$pack\::$name"} = 1;
} elsif ($type eq 's' || $subname eq '(definitions)') {
# definition
@@ -605,7 +607,8 @@ sub _var_ret_list
if ($mod) {
@r = exists $h->{$mod} ? @{$h->{$mod}} : ();
} else {
- @r = map { @$_ } values %$h;
+ ## XXX: Need to revisit when this is/isn't an array!
+ @r = map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %$h;
}
@r = grep $_->{assign}, @r if $assign;
@r = map { [@{$_}{qw(file line sub package)}] } @r;
diff --git a/sepia-ido.el b/sepia-ido.el
index 97c85a2..c8f657f 100644
--- a/sepia-ido.el
+++ b/sepia-ido.el
@@ -1,4 +1,4 @@
-(require 'ido)
+(require 'ido nil t)
(require 'cl)
(defun* sepia-icompleting-recursive-read (prompt dir &key
diff --git a/sepia-tree.el b/sepia-tree.el
index 4c0a87b..1d0acb4 100644
--- a/sepia-tree.el
+++ b/sepia-tree.el
@@ -10,7 +10,7 @@
;;; Code:
-(require 'tree-widget)
+(require 'tree-widget nil t)
(defun sepia-tree-button-cb (widget &rest blah)
(let* ((pw (widget-get widget :parent))
diff --git a/sepia-w3m.el b/sepia-w3m.el
index d38398c..7fe615c 100644
--- a/sepia-w3m.el
+++ b/sepia-w3m.el
@@ -33,7 +33,7 @@
;; http://emacs-w3m.namazu.org/
;;; Code:
-(require 'w3m-perldoc)
+(require 'w3m-perldoc nil t)
;;;###autoload
(defun w3m-about-perldoc-buffer (url &optional no-decode no-cache &rest args)
diff --git a/sepia.el b/sepia.el
index 278da31..a0a7f86 100644
--- a/sepia.el
+++ b/sepia.el
@@ -7,12 +7,18 @@
;;; Commentary:
-;; See the README file that comes with the distribution.
+;; Sepia is a set of tools for Perl development in Emacs. Its goal is
+;; to extend CPerl mode with two contributions: fast code navigation
+;; and interactive development. It is inspired by Emacs' current
+;; support for a number of other languages, including Lisp, Python,
+;; Ruby, and Emacs Lisp.
+;;
+;; See sepia.texi, which comes with the distribution.
;;; Code:
(require 'cperl-mode)
-(require 'comint)
+(require 'gud)
(require 'cl)
;; try optional modules, but don't bitch if we fail:
(require 'sepia-w3m nil t)
@@ -23,7 +29,7 @@
;;; Comint communication
(defvar sepia-perl5lib nil
-"* Extra PERL5LIB directory for Sepia.pm")
+"* List of extra PERL5LIB directories for `sepia-repl'.")
(defvar sepia-program-name "perl"
"* Perl program name.")
@@ -36,7 +42,7 @@ Useful values include `w3m-perldoc' and `cperl-perldoc'.")
(defvar sepia-view-pod-function
(if (featurep 'w3m) 'sepia-w3m-view-pod 'sepia-perldoc-buffer)
-"* Function to view modules' documentation.
+"* Function to view current buffer's documentation.
Useful values include `sepia-w3m-view-pod' and `sepia-perldoc-buffer'.")
@@ -46,6 +52,33 @@ Useful values include `sepia-w3m-view-pod' and `sepia-perldoc-buffer'.")
Useful values include `w3m-find-file' and `browse-url-of-buffer'.")
+(defvar sepia-complete-methods t
+"* Non-nil if Sepia should try to complete methods for \"$x->\".
+
+NOTE: this feature can be problematic, since it evaluates the
+object in order to find its type. Currently completion is only
+attempted for objects that are simple scalars.")
+
+(defvar sepia-indent-expand-abbrev t
+"* If non-NIL, `sepia-indent-or-complete' tries `expand-abbrev'.")
+
+(defvar sepia-use-completion t
+ "* Use completion based on Xref database.
+
+Turning this off may speed up some operations, if you don't mind
+losing completion.")
+
+(defvar sepia-eval-defun-include-decls t
+ "* Generate and use a declaration list for `sepia-eval-defun'.
+Without this, code often will not parse; with it, evaluation may
+be a bit less responsive. Note that since this only includes
+subs from the evaluation package, it may not always work.")
+
+(defvar sepia-prefix-key "\M-."
+ "* Prefix for functions in `sepia-keymap'.")
+
+;;; User options end here.
+
(defvar sepia-process nil
"The perl process with which we're interacting.")
(defvar sepia-output nil
@@ -64,41 +97,44 @@ look for \";;;###\" lisp evaluation markers.")
"")
(defun sepia-eval-raw (str)
-"Evaluate perl code STR, returning a pair (RESULT-STRING . OUTPUT)."
- (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)))))
+ "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))))
+ '("")))
(defun sepia-eval (str &optional context detailed)
"Evaluate STR in CONTEXT (void by default), and return its result
@@ -113,7 +149,9 @@ pair (RESULT . OUTPUT)."
(t (concat str ";1")))))
(res (car tmp))
(errs (cdr tmp)))
- (setq res (if context (car (read-from-string res)) 1))
+ (setq res (if context
+ (if (string= res "") "" (car (read-from-string res)))
+ 1))
(if detailed
(cons res errs)
res)))
@@ -151,83 +189,63 @@ each inferior Perl prompt."
"")
(t (setq sepia-passive-output "") string)))
-(defun sepia-comint-setup ()
-"Set up the inferior Perl process buffer."
- (comint-mode)
- (set (make-local-variable 'comint-dynamic-complete-functions)
- '(sepia-complete-symbol comint-dynamic-complete-filename))
- (set (make-local-variable 'comint-preoutput-filter-functions)
- '(sepia-watch-for-eval))
- (set (make-local-variable 'comint-use-prompt-regexp) t)
- (modify-syntax-entry ?: "_")
- (modify-syntax-entry ?> ".")
- (use-local-map (copy-keymap (current-local-map)))
- (sepia-install-keys)
- (local-set-key (kbd "TAB") 'comint-dynamic-complete)
- (local-set-key "\C-a" 'comint-bol)
- (set (make-local-variable 'comint-prompt-regexp)
- "^[^>\n]*> *")
- )
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Keymaps, user variables, setup.
-
-(defvar sepia-use-completion t
- "* Use completion based on Xref database. Turning this off may
-speed up some operations, if you don't mind losing completion.")
-
-(defvar sepia-eval-defun-include-decls t
- "* Generate and use a declaration list for ``sepia-eval-defun''.
-Without this, code often will not parse; with it, evaluation may
-be a bit less responsive. Note that since this only includes
-subs from the evaluation package, it may not always work.")
-
-(defvar sepia-prefix-key "\M-."
- "* Prefix for functions in ``sepia-keymap''.")
-
-(defvar sepia-keymap
- (eval-when (load eval)
- (let ((km (make-sparse-keymap)))
- (dolist (kv '(("c" . sepia-callers)
- ("C" . sepia-callees)
- ("a" . sepia-apropos)
- ("A" . sepia-var-apropos)
- ("v" . sepia-var-uses)
- ("V" . sepia-var-defs)
- ;; ("V" . sepia-var-assigns)
- ("\M-." . sepia-dwim)
- ;; ("\M-." . sepia-location)
- ("l" . sepia-location)
- ("f" . sepia-defs)
- ("r" . sepia-rebuild)
- ("m" . sepia-module-find)
- ("n" . sepia-next)
- ("t" . find-tag)
- ("d" . sepia-perldoc-this)))
- (define-key km (car kv) (cdr kv)))
- (when (featurep 'ido)
- (define-key km "j" 'sepia-jump-to-symbol))
- km))
+(defvar sepia-metapoint-map
+ (let ((map (make-sparse-keymap)))
+ (when (featurep 'ido)
+ (define-key map "j" 'sepia-jump-to-symbol))
+ (dolist (kv '(("c" . sepia-callers)
+ ("C" . sepia-callees)
+ ("a" . sepia-apropos)
+ ("A" . sepia-var-apropos)
+ ("v" . sepia-var-uses)
+ ("V" . sepia-var-defs)
+ ;; ("V" . sepia-var-assigns)
+ ("\M-." . sepia-dwim)
+ ;; ("\M-." . sepia-location)
+ ("l" . sepia-location)
+ ("f" . sepia-defs)
+ ("r" . sepia-rebuild)
+ ("m" . sepia-module-find)
+ ("n" . sepia-next)
+ ("t" . find-tag)
+ ("d" . sepia-perldoc-this)))
+ (define-key map (car kv) (cdr kv)))
+ map)
"Keymap for Sepia functions. This is just an example of how you
might want to bind your keys, which works best when bound to
`\\M-.'.")
-(defun sepia-install-keys (&optional map)
-"Install Sepia bindings in the current local keymap."
- (interactive)
- (let ((map (or map (current-local-map))))
- (define-key map sepia-prefix-key sepia-keymap)
+(defvar sepia-shared-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map sepia-prefix-key sepia-metapoint-map)
(define-key map "\M-," 'sepia-next)
(define-key map "\C-\M-x" 'sepia-eval-defun)
(define-key map "\C-c\C-l" 'sepia-load-file)
(define-key map "\C-c\C-d" 'sepia-view-pod)
- (define-key map (kbd "TAB") 'sepia-indent-or-complete)))
+ (define-key map "\C-c\C-r" 'sepia-repl)
+ (define-key map "\C-c\C-s" 'sepia-scratch)
+ (define-key map "\C-c!" 'sepia-set-cwd)
+ (define-key map (kbd "TAB") 'sepia-indent-or-complete)
+ map)
+ "Sepia bindings common to all modes.")
;;;###autoload
(defun sepia-perldoc-this (name)
"View perldoc for module at point."
(interactive (list (sepia-interactive-arg 'module)))
- (funcall sepia-perldoc-function name))
+ (let ((wc (current-window-configuration))
+ (old-pd (symbol-function 'w3m-about-perldoc))
+ (old-pdb (symbol-function 'w3m-about-perldoc-buffer)))
+ (condition-case stuff
+ (flet ((w3m-about-perldoc (&rest args)
+ (let ((res (apply old-pd args)))
+ (or res (error "lose: %s" args))))
+ (w3m-about-perldoc-buffer (&rest args)
+ (let ((res (apply old-pdb args)))
+ (or res (error "lose: %s" args)))))
+ (funcall sepia-perldoc-function name))
+ (error (set-window-configuration wc)))))
(defun sepia-view-pod ()
"View POD for the current buffer."
@@ -242,8 +260,8 @@ files, but all documented modules on the system, organized by
package."
(interactive)
(let ((file "/tmp/modlist.html"))
- (unless (file-exists-p file)
- (sepia-eval (format "Sepia::html_module_list(\"%s\")" file)))
+ ;; (unless (file-exists-p file)
+ (sepia-eval-raw (format "Sepia::html_module_list(\"%s\")" file))
(funcall sepia-module-list-function file)))
(defun sepia-package-list ()
@@ -253,8 +271,8 @@ This lists only top-level packages appearing in packlist files.
For modules within packages, see `sepia-module-list'."
(interactive)
(let ((file "/tmp/packlist.html"))
- (unless (file-exists-p file)
- (sepia-eval (format "Sepia::html_package_list(\"%s\")" file)))
+ ;; (unless (file-exists-p file)
+ (sepia-eval-raw (format "Sepia::html_package_list(\"%s\")" file))
(funcall sepia-module-list-function file)))
(defun sepia-perldoc-buffer ()
@@ -268,117 +286,98 @@ For modules within packages, see `sepia-module-list'."
buffer nil errs))
(with-current-buffer buffer (browse-url-of-buffer))))
-(defun perl-name (sym &optional mod)
+(defun sepia-perl-name (sym &optional mod)
"Convert a Perl name to a Lisp name."
(setq sym (substitute ?_ ?- (if (symbolp sym) (symbol-name sym) sym)))
(if mod
(concat mod "::" sym)
sym))
+(defun sepia-live-p ()
+ (and (processp sepia-process)
+ (eq (process-status sepia-process) 'run)))
+
;;;###autoload
-(defun sepia-init (&optional noinit)
-"Perform the initialization necessary to start Sepia.
-
-The following keys are bound to the prefix
-``sepia-prefix-key'' (`\\M-.' by default), which can be changed
-by setting ``sepia-prefix'' before calling ``sepia-init'':
-
-\\{sepia-keymap}
-In addition to these keys, Sepia defines the following keys,
-which may conflict with keys in your setup, but which are
-intended to shadow similar functionality in elisp-mode:
-
-`\\C-c\\C-d' ``sepia-view-pod''
-`\\C-c\\C-l' ``sepia-load-file''
-`\\C-\\M-x' ``sepia-eval-defun''
-`\\M-,' ``sepia-next'' (shadows ``tags-loop-continue'')
-"
- (interactive "P")
- (ignore-errors
- (kill-process "perl")
- (setq sepia-process nil))
- (unless noinit
- ;; Load perl defs:
+(defun sepia-repl ()
+ "Start the Sepia REPL."
+ (interactive)
+ (sepia-init) ;; set up keymaps, etc.
+ (unless (sepia-live-p)
(setq sepia-process
(get-buffer-process
- (comint-exec (get-buffer-create "*perl-interaction*")
+ (comint-exec (get-buffer-create "*sepia-repl*")
"perl" sepia-program-name nil
- (append (and sepia-perl5lib
- (mapcar
- (lambda (x) (concat "-I" x))
- (split-string sepia-perl5lib ":")))
- '("-MData::Dumper" "-MSepia" "-MSepia::Xref"
- "-e" "Sepia::repl(*STDIN)")))))
- (with-current-buffer "*perl-interaction*"
- (sepia-comint-setup))
- (accept-process-output sepia-process 0 1)
-
- ;; Create glue wrappers for Module::Info funcs.
- (dolist (x '((name "Find module name.\n\nDoes not require loading.")
- (version "Find module version.\n\nDoes not require loading.")
- (inc-dir
-"Find directory in which this module was found.\n\nDoes not require loading.")
- (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.")))
- (apply #'define-modinfo-function x))
-
- ;; Create low-level wrappers for Sepia
- (dolist (x '((completions "Find completions in the symbol table.")
- (method-completions "Complete on an object's methods.")
- (location "Find an identifier's location.")
- (mod-subs "Find all subs defined in a package.")
- (mod-decls "Generate declarations for subs in a package.")
- (mod-file "Find the file defining a package.")
- (apropos "Find subnames matching RE.")
- (lexicals "Find lexicals for a sub.")
- ))
- (apply #'define-xref-function "Sepia" x))
-
- (dolist (x '((rebuild "Build Xref database for current Perl process.")
- (redefined "Rebuild Xref information for a given sub.")
-
- (callers "Find all callers of a function.")
- (callees "Find all functions called by a function.")
-
- (var-apropos "Find varnames matching RE.")
- (mod-apropos "Find modules matching RE.")
- (file-apropos "Find files matching RE.")
-
- (var-defs "Find all definitions of a variable.")
- (var-assigns "Find all assignments to a variable.")
- (var-uses "Find all uses of a variable.")
-
- (mod-redefined "Rebuild Xref information for a given package.")
- (guess-module-file "Guess file corresponding to module.")
- (file-modules "List the modules defined in a file.")))
- (apply #'define-xref-function "Sepia::Xref" x))
-
- ;; Initialize built hash
- (sepia-init-perl-builtins))
- (add-hook 'cperl-mode-hook 'sepia-install-eldoc)
- (add-hook 'cperl-mode-hook 'sepia-doc-update)
- (add-hook 'cperl-mode-hook 'sepia-cperl-mode-hook)
- (when (boundp 'cperl-mode-map)
- (sepia-install-keys cperl-mode-map))
- (when (boundp 'perl-mode-map)
- (sepia-install-keys perl-mode-map))
- (unless noinit
- (sepia-interact)))
-
-(defun sepia-cperl-mode-hook ()
- (set (make-local-variable 'beginning-of-defun-function)
- 'sepia-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- 'sepia-end-of-defun))
+ (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))
+ (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)
+ )
+ (pop-to-buffer (get-buffer "*sepia-repl*")))
+
+(defvar sepia-repl-mode-map
+ (let ((map (copy-keymap sepia-shared-map)))
+ (set-keymap-parent map gud-mode-map)
+ (define-key map (kbd "<tab>") 'comint-dynamic-complete)
+ (define-key map "\C-a" 'comint-bol)
+ map)
+
+"Keymap for Sepia interactive mode.")
+
+(define-derived-mode sepia-repl-mode gud-mode "Sepia REPL"
+ "Major mode for the Sepia REPL.
+
+\\{sepia-repl-mode-map}"
+ (set (make-local-variable 'comint-dynamic-complete-functions)
+ '(sepia-complete-symbol comint-dynamic-complete-filename))
+ (set (make-local-variable 'comint-preoutput-filter-functions)
+ '(sepia-watch-for-eval))
+ ;; (set (make-local-variable 'comint-use-prompt-regexp) t)
+ (modify-syntax-entry ?: "_")
+ (modify-syntax-entry ?> ".")
+ (set (make-local-variable 'comint-prompt-regexp) "^[^>\n]*> *")
+ (set (make-local-variable 'gud-target-name) "sepia")
+ (set (make-local-variable 'gud-marker-filter) 'sepia-gud-marker-filter)
+ (set (make-local-variable 'gud-minor-mode) 'sepia)
+
+ (setq gud-comint-buffer (current-buffer))
+ (setq gud-last-last-frame nil)
+ (setq gud-sepia-acc nil)
+
+ (gud-def gud-break ",break %f:%l" "\C-b" "Set breakpoint at current line.")
+ (gud-def gud-step ",step %p" "\C-s" "Step one line.")
+ (gud-def gud-next ",next %p" "\C-n" "Step one line, skipping calls.")
+ (gud-def gud-cont ",continue" "\C-r" "Continue.")
+ (gud-def gud-print "%e" "\C-p" "Evaluate something.")
+ (gud-def gud-remove ",delete %l %f" "\C-d" "Delete current breakpoint.")
+ (run-hooks 'sepia-repl-mode-hook))
+
+(defvar gud-sepia-acc nil
+ "Accumulator for `sepia-gud-marker-filter'.")
+
+(defun sepia-gud-marker-filter (str)
+ (setq gud-sepia-acc
+ (if gud-sepia-acc
+ (concat gud-sepia-acc str)
+ str))
+ (while (string-match "_<\\([^:>]+\\):\\([0-9]+\\)>\\(.*\\)" gud-sepia-acc)
+ (setq gud-last-last-frame gud-last-frame
+ gud-last-frame (cons
+ (match-string 1 gud-sepia-acc)
+ (string-to-number (match-string 2 gud-sepia-acc)))
+ gud-sepia-acc (match-string 3 gud-sepia-acc)))
+ (setq gud-sepia-acc
+ (if (string-match "\\(_<.*\\)" gud-sepia-acc)
+ (match-string 1 gud-sepia-acc)
+ nil))
+ str)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Xref
@@ -386,7 +385,7 @@ Does not require loading.")
(defun define-xref-function (package name doc)
"Define a lisp mirror for a low-level Sepia function."
(let ((lisp-name (intern (format "xref-%s" name)))
- (pl-name (perl-name name package)))
+ (pl-name (sepia-perl-name name package)))
(fmakunbound lisp-name)
(eval `(defun ,lisp-name (&rest args)
,doc
@@ -395,7 +394,7 @@ Does not require loading.")
(defun define-modinfo-function (name &optional doc)
"Define a lisp mirror for a function from Module::Info."
(let ((name (intern (format "sepia-module-%s" name)))
- (pl-func (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
@@ -409,12 +408,11 @@ module in question be loaded.")))
mod ,pl-func))))))
(defun sepia-thing-at-point (what)
- "Like ``thing-at-point'', but hacked to avoid REPL prompt."
+ "Like `thing-at-point', but hacked to avoid REPL prompt."
(let ((th (thing-at-point what)))
(and th (not (string-match "[ >]$" th)) th)))
-(defvar sepia-sub-re "^\\s *sub\\s +\\(.+\\_>\\)")
-
+(defvar sepia-sub-re "^ *sub\\s +\\(.+\\_>\\)")
(defvar sepia-history nil)
@@ -433,12 +431,13 @@ symbol at point."
(function (xref-apropos str))
(module (xref-mod-apropos str))
(t nil)))))
+ (prompt (if default
+ (format "%s [%s]: " text default)
+ (format "%s: " text)))
(ret (if sepia-use-completion
- (completing-read (format "%s [%s]: " text default)
- choices nil nil nil 'sepia-history
+ (completing-read prompt choices nil nil nil 'sepia-history
default)
- (read-string (format "%s [%s]: " text default)
- nil 'sepia-history default))))
+ (read-string prompt nil 'sepia-history default))))
(push ret sepia-history)
ret))
@@ -466,9 +465,11 @@ symbol at point."
"Find the file defining module MOD."
(interactive (list (sepia-interactive-arg 'module)))
(let ((fn (sepia-find-module-file mod)))
- (when fn
- (message "Module %s in %s." mod fn)
- (pop-to-buffer (find-file-noselect (expand-file-name fn))))))
+ (if fn
+ (progn
+ (message "Module %s in %s." mod fn)
+ (pop-to-buffer (find-file-noselect (expand-file-name fn))))
+ (message "Can't find module %s." mod))))
(defmacro ifa (test then &rest else)
`(let ((it ,test))
@@ -496,8 +497,8 @@ symbol at point."
(line-number-at-pos))
(setq line (line-number-at-pos))
(let ((tmpstr
- (buffer-substring (my-bol-from (point))
- (my-eol-from (point)))))
+ (buffer-substring (sepia-bol-from (point))
+ (sepia-eol-from (point)))))
(if (> (length tmpstr) 60)
(concat "\n " tmpstr)
tmpstr)))
@@ -511,9 +512,9 @@ symbol at point."
`(defun ,name (ident &optional module file line display-p)
,(concat doc "
-With prefix arg, list occurences in a ``grep-mode'' buffer.
-Without, place the occurrences on ``sepia-found'', so that
-calling ``sepia-next'' will cycle through them.
+With prefix arg, list occurences in a `grep-mode' buffer.
+Without, place the occurrences on `sepia-found', so that
+calling `sepia-next' will cycle through them.
Depending on the query, MODULE, FILE, and LINE may be used to
narrow the results, as long as doing so leaves some matches.
@@ -539,7 +540,6 @@ buffer.
(sepia-set-found ret ',(or prompt 'function))
(sepia-next)))))
-
(define-sepia-query sepia-defs
"Find all definitions of sub."
xref-apropos
@@ -598,9 +598,7 @@ buffer.
When called interactively (or with JUMP-TO true), go directly
to this location."
- (interactive (list (or (thing-at-point 'symbol)
- (completing-read "Function: " 'xref-completions))
- t))
+ (interactive (list (sepia-interactive-arg 'function) t))
(let* ((fl (or (car (xref-location name))
(car (remove-if #'null
(apply #'xref-location (xref-apropos name)))))))
@@ -625,7 +623,7 @@ to this location."
(interactive "P")
(multiple-value-bind (type obj) (sepia-ident-at-point)
(sepia-set-found nil type)
- (let* (module-doc-p
+ (let* ((module-doc-p nil)
(ret
(cond
((member type '(?% ?$ ?@)) (xref-var-defs obj))
@@ -633,9 +631,11 @@ to this location."
(let (case-fold-search)
(string-match "^[^A-Z]" obj)))
(list (sepia-location obj)))
- (t
+ ((sepia-looks-like-module obj)
(setq module-doc-p t)
- `((,(sepia-perldoc-this obj) 1 nil nil))))))
+ `((,(sepia-perldoc-this obj) 1 nil nil)))
+ (t (setq module-doc-p t)
+ (call-interactively 'sepia-defs)))))
(unless module-doc-p
(if display-p
(sepia-show-locations ret)
@@ -672,32 +672,47 @@ to this location."
(defun sepia-beginning-of-defun (&optional n)
"Move to beginning of current function.
-If prefix argument given, move N functions backward."
+The prefix argument is the same as for `beginning-of-defun'."
(interactive "p")
- (let ((here (point)))
- (beginning-of-line)
- (if (and (not (= here (point)))
- (looking-at sepia-sub-re))
- (point)
- (sepia-safe-bodf n)
- (let* ((end (point))
- (beg (progn (forward-line -3) (point))))
- (goto-char end)
- (re-search-backward sepia-sub-re beg t)))))
+ (setq n (or n 1))
+ (ignore-errors
+ (when (< n 0)
+ (sepia-end-of-defun (- n))
+ (setq n 1))
+ (re-search-backward sepia-sub-re nil nil n)))
+
+(defun sepia-inside-defun ()
+ "True if point is inside a sub."
+ (condition-case nil
+ (save-excursion
+ (let ((cur (point)))
+ (re-search-backward sepia-sub-re)
+ (when (< (point) cur)
+ (search-forward "{")
+ (backward-char 1)
+ (forward-sexp)
+ (> (point) cur))))
+ (error nil)))
(defun sepia-end-of-defun (&optional n)
"Move to end of current function.
-If prefix argument given, move N functions forward."
+The prefix argument is the same as for `end-of-defun'."
(interactive "p")
- (let ((here (point)))
- ;; (sepia-safe-bodf)
- (when (looking-at sepia-sub-re)
- (forward-line 1))
- (sepia-safe-eodf n)
- (when (and (>= here (point))
- (re-search-forward sepia-sub-re nil t))
- (sepia-safe-eodf))
+ (setq n (or n 1))
+ (when (< n 0)
+ (sepia-beginning-of-defun (- n))
+ (setq n 1))
+ ;; If we're outside a defun, skip to the next
+ (ignore-errors
+ (unless (sepia-inside-defun)
+ (re-search-forward sepia-sub-re)
+ (forward-char 1))
+ (dotimes (i n)
+ (re-search-backward sepia-sub-re)
+ (search-forward "{")
+ (backward-char 1)
+ (forward-sexp))
(point)))
(defun sepia-defun-around-point (&optional where)
@@ -717,7 +732,7 @@ If prefix argument given, move N functions forward."
(setq where (point)))
(let ((subname (sepia-defun-around-point where))
(mod (sepia-buffer-package)))
- (xref-lexicals (perl-name subname mod))))
+ (xref-lexicals (sepia-perl-name subname mod))))
;;;###autoload
(defun sepia-load-file (file &optional rebuild-p collect-warnings)
@@ -729,7 +744,8 @@ also rebuild the xref database."
prefix-arg
(format "*%s errors*" (buffer-file-name))))
(save-buffer)
- (let* ((tmp (sepia-eval (format "do '%s' ? 1 : $@" file) 'scalar-context t))
+ (let* ((tmp (sepia-eval (format "do '%s' || ($@ && die $@)" file)
+ 'scalar-context t))
(res (car tmp))
(errs (cdr tmp)))
(message "sepia: %s returned %s" (abbreviate-file-name file) res)
@@ -777,17 +793,17 @@ also rebuild the xref database."
;; Old version -- this may actually work better if
;; beginning-of-defun goes flaky on us.
;; (or (re-search-backward sub-re
-;; (my-bol-from (point) -20) t)
+;; (sepia-bol-from (point) -20) t)
;; (re-search-forward sub-re
-;; (my-bol-from (point) 10) t))
+;; (sepia-bol-from (point) 10) t))
;; (beginning-of-line)
(variable
(lambda (line ident)
(let ((var-re (concat "\\_<" ident "\\_>")))
(cond
(line (goto-line line)
- (or (re-search-backward var-re (my-bol-from (point) -5) t)
- (re-search-forward var-re (my-bol-from (point) 5) t)))
+ (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))))))
(t (lambda (line ident) (and line (goto-line line))))))
@@ -820,26 +836,16 @@ also rebuild the xref database."
(defun sepia-ident-before-point ()
"Find the Perl identifier at or preceding point."
(save-excursion
- (when (looking-at "[%$@*&]")
- (forward-char 1))
(let* ((end (point))
(beg (progn
- (when (re-search-backward "[^A-Za-z_0-9:]" nil 'mu)
- (forward-char 1))
- (point)))
+ (skip-chars-backward "a-zA-Z0-9_:")
+ (point)))
(sigil (if (= beg (point-min))
nil
(char-before (point)))))
(list (when (member sigil '(?$ ?@ ?% ?* ?&)) sigil)
(buffer-substring-no-properties beg end)))))
-(defvar sepia-complete-methods t
-"* Non-nil if Sepia should try to complete methods for \"$x->\".
-
-NOTE: this feature can be problematic, since it evaluates the
-object in order to find its type. Currently completion is only
-attempted for objects that are simple scalars.")
-
(defun sepia-simple-method-before-point ()
"Find the \"simple\" method call before point.
@@ -864,7 +870,9 @@ expressions would lead to disaster."
((char-equal (char-before (point)) ?$)
(setq beg (1- (point))))
;; X::Class->method
- ((looking-at "[A-Z][a-z]")
+ ((multiple-value-bind (type obj) (sepia-ident-at-point)
+ (and (not type)
+ (sepia-looks-like-module obj)))
(setq beg (point))))
(when beg
(list (buffer-substring-no-properties beg arrow)
@@ -917,7 +925,7 @@ function currently ignores module qualifiers, which may be
annoying in larger programs.
The function is intended to be bound to \\M-TAB, like
-``lisp-complete-symbol''."
+`lisp-complete-symbol'."
(interactive)
(let ((win (get-buffer-window "*Completions*" 0))
len
@@ -962,8 +970,8 @@ The function is intended to be bound to \\M-TAB, like
(?& "CODE")
(?* "IO")
(t ""))
- (unless (eq major-mode 'comint-mode)
- (sepia-function-at-point)))))
+ (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 ?&)))
@@ -973,15 +981,13 @@ The function is intended to be bound to \\M-TAB, like
(case (length completions)
(0 (message "No completions for %s." name) nil)
(1 ;; XXX - skip sigil to match s-i-before-point
- (when (looking-at "[%$@*&]")
- (forward-char 1))
(delete-region (- (point) len) (point))
(insert (or type "") (car completions))
;; Hide stale completions buffer (stolen from lisp.el).
(if win (with-selected-window win (bury-buffer))) t)
(t (let ((old name)
(new (try-completion "" completions)))
- (if (string= new old)
+ (if (<= (length new) (length old))
(with-output-to-temp-buffer "*Completions*"
(display-completion-list completions))
(let ((win (get-buffer-window "*Completions*" 0)))
@@ -990,9 +996,6 @@ The function is intended to be bound to \\M-TAB, like
(insert (or type "") new))))))
t)))
-(defvar sepia-indent-expand-abbrev t
-"* If non-NIL, `sepia-indent-or-complete' tries `expand-abbrev'.")
-
(defun sepia-indent-or-complete ()
"Indent the current line or complete the symbol around point.
@@ -1007,103 +1010,188 @@ This function is intended to be bound to TAB."
(not (bolp))
(or (eq last-command 'sepia-indent-or-complete)
(looking-at "\\_>")))
- (when (or (not sepia-indent-expand-abbrev)
- (expand-abbrev))
+ (unless (and sepia-indent-expand-abbrev
+ (expand-abbrev))
(sepia-complete-symbol)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; scratchpad code
+(defvar sepia-mode-map
+ (let ((map (copy-keymap sepia-shared-map)))
+ (set-keymap-parent map cperl-mode-map)
+ (define-key map "\C-c\C-h" nil)
+ map)
+ "Keymap for Sepia mode.")
+
;;;###autoload
-(defun sepia-scratch ()
- "Create a buffer to interact with a Perl interpreter.
+(define-derived-mode sepia-mode cperl-mode "Sepia"
+ "Major mode for Perl editing, derived from cperl mode.
+\\{sepia-mode-map}"
+ (sepia-init)
+ (sepia-install-eldoc)
+ (sepia-doc-update)
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'sepia-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ 'sepia-end-of-defun))
+
+(defun sepia-init ()
+ "Perform the initialization necessary to start Sepia."
+ ;; Load perl defs:
+ ;; Create glue wrappers for Module::Info funcs.
+ (unless (fboundp 'xref-completions)
+ (dolist (x '((name "Find module name.\n\nDoes not require loading.")
+ (version "Find module version.\n\nDoes not require loading.")
+ (inc-dir "Find directory in which this module was found.\n\nDoes not require loading.")
+ (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.")))
+ (apply #'define-modinfo-function x))
+ ;; Create low-level wrappers for Sepia
+ (dolist (x '((completions "Find completions in the symbol table.")
+ (method-completions "Complete on an object's methods.")
+ (location "Find an identifier's location.")
+ (mod-subs "Find all subs defined in a package.")
+ (mod-decls "Generate declarations for subs in a package.")
+ (mod-file "Find the file defining a package.")
+ (apropos "Find subnames matching RE.")
+ (lexicals "Find lexicals for a sub.")
+ ))
+ (apply #'define-xref-function "Sepia" x))
+
+ (dolist (x '((rebuild "Build Xref database for current Perl process.")
+ (redefined "Rebuild Xref information for a given sub.")
+
+ (callers "Find all callers of a function.")
+ (callees "Find all functions called by a function.")
+
+ (var-apropos "Find varnames matching RE.")
+ (mod-apropos "Find modules matching RE.")
+ (file-apropos "Find files matching RE.")
+
+ (var-defs "Find all definitions of a variable.")
+ (var-assigns "Find all assignments to a variable.")
+ (var-uses "Find all uses of a variable.")
+
+ (mod-redefined "Rebuild Xref information for a given package.")
+ (guess-module-file "Guess file corresponding to module.")
+ (file-modules "List the modules defined in a file.")))
+ (apply #'define-xref-function "Sepia::Xref" x))
+ ;; Initialize built hash
+ (sepia-init-perl-builtins)))
+
+(defvar sepia-scratchpad-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map sepia-mode-map)
+ (define-key map "\C-j" 'sepia-scratch-send-line)
+ map))
-The buffer is placed in cperl-mode; calling
-``sepia-scratch-send-line'' will evaluate the current line and
-display the result."
+;;;###autoload
+(define-derived-mode sepia-scratchpad-mode sepia-mode "Sepia-Scratch"
+ "Major mode for the Perl scratchpad, derived from Sepia mode."
+ (sepia-init))
+
+;;;###autoload
+(defun sepia-scratch ()
+ "Switch to the sepia scratchpad."
(interactive)
- (switch-to-buffer (get-buffer-create "*perl-scratch*"))
- (cperl-mode)
- (local-set-key "\C-j" 'sepia-scratch-send-line))
+ (pop-to-buffer
+ (or (get-buffer "*sepia-scratch*")
+ (with-current-buffer (get-buffer-create "*sepia-scratch*")
+ (sepia-scratchpad-mode)
+ (current-buffer)))))
(defun sepia-scratch-send-line (&optional scalarp)
"Send the current line to perl, and display the result."
(interactive "P")
- (insert
- (sepia-eval (concat "do{"
- (buffer-substring (my-bol-from (point))
- (my-eol-from (point)))
- "}") 'scalar-context)))
+ (insert "\n"
+ (format "%S" (sepia-eval-raw (concat "scalar do{"
+ (buffer-substring (sepia-bol-from (point))
+ (sepia-eol-from (point)))
+ "}")))
+ "\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Miscellany
-(defun my-perl-frob-region (pre post beg end replace-p)
+(defun sepia-string-count-matches (reg str)
+ (let ((n 0)
+ (pos -1))
+ (while (setq pos (string-match reg str (1+ pos)))
+ (incf n))
+ n))
+
+(defun sepia-perlize-region-internal (pre post beg end replace-p)
"Pass buffer text from BEG to END through a Perl command."
(let* ((exp (concat pre "<<'SEPIA_END_REGION';\n"
(buffer-substring-no-properties beg end)
(if (= (char-before end) ?\n) "" "\n")
"SEPIA_END_REGION\n" post))
- (new-str (sepia-eval exp 'scalar-context)))
+ (new-str (car (sepia-eval-raw exp))))
(if replace-p
(progn (delete-region beg end)
(goto-char beg)
(insert new-str))
- (message new-str))))
-
-(defun my-eol-from (pt &optional n)
+ (if (> (sepia-string-count-matches "\n" new-str) 2)
+ (with-current-buffer (get-buffer-create "*sepia-filter*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert new-str)
+ (goto-char (point-min))
+ (pop-to-buffer (current-buffer))))
+ (message "%s" new-str)))))
+
+(defun sepia-eol-from (pt &optional n)
(save-excursion
(goto-char pt)
(end-of-line n)
(point)))
-(defun my-bol-from (pt &optional n)
+(defun sepia-bol-from (pt &optional n)
(save-excursion
(goto-char pt)
(beginning-of-line n)
(point)))
-;; asdf asdf asdf
-;; asdf asdf asdf
-
-(defun perl-pe-region (expr beg end &optional replace-p)
+(defun sepia-perl-pe-region (expr beg end &optional replace-p)
"Do the equivalent of perl -pe on region
\(i.e. evaluate an expression on each line of region). With
prefix arg, replace the region with the result."
(interactive "MExpression: \nr\nP")
- (my-perl-frob-region
- "do { my $ret='';my $region = "
- (concat "; for (split /\n/, $region) { do { " expr
- ";}; $ret.=\"$_\\n\"}; $ret}")
- (my-bol-from beg) (my-eol-from end) replace-p))
+ (sepia-perlize-region-internal
+ "do { my $ret=''; local $_; local $/ = \"\\n\"; my $region = "
+ (concat "; for (split /(?<=\\n)/, $region, -1) { " expr
+ "} continue { $ret.=$_}; $ret}")
+ (sepia-bol-from beg) (sepia-eol-from end) replace-p))
-(defun perl-ne-region (expr beg end &optional replace-p)
+(defun sepia-perl-ne-region (expr beg end &optional replace-p)
"Do the moral equivalent of perl -ne on region
\(i.e. evaluate an expression on each line of region). With
prefix arg, replace the region with the result."
(interactive "MExpression:\nr\nP")
- (my-perl-frob-region
+ (sepia-perlize-region-internal
"do { my $ret='';my $region = "
- (concat "; for (split /\n/, $region) { $ret .= do { " expr
+ (concat "; for (split /(?<=\\n)/, $region, -1) { $ret .= do { " expr
";} }; ''.$ret}")
- (my-bol-from beg) (my-eol-from end) replace-p))
+ (sepia-bol-from beg) (sepia-eol-from end) replace-p))
-(defun perl-ize-region (expr beg end &optional replace-p)
+(defun sepia-perlize-region (expr beg end &optional replace-p)
"Evaluate a Perl expression on the region as a whole.
With prefix arg, replace the region with the result."
(interactive "MExpression:\nr\nP")
- (my-perl-frob-region "do { local $_ = "
- (concat "; do { " expr ";}; $_ }")
- beg end replace-p))
+ (sepia-perlize-region-internal
+ "do { local $_ = " (concat "; do { " expr ";}; $_ }") beg end replace-p))
(defun sepia-core-version (module &optional message)
"Report the first version of Perl shipping with MODULE."
- (interactive (list (read-string "Module: "
- nil nil (sepia-thing-at-point 'symbol))
- t))
+ (interactive (list (sepia-interactive-arg 'module) t))
(let* ((version
(sepia-eval
(format "eval { Sepia::core_version('%s') }" module)
@@ -1129,25 +1217,48 @@ With prefix arg, replace the region with the result."
(defun sepia-eval-defun ()
"Re-evaluate the current function and rebuild its Xrefs."
(interactive)
- (save-excursion
- (let* ((pt (point))
- (end (progn (end-of-defun) (point)))
- (beg (progn (goto-char pt) (beginning-of-defun) (point))))
+ (let (pt end beg sub res
+ sepia-eval-package
+ sepia-eval-file
+ sepia-eval-line)
+ (save-excursion
+ (setq pt (point)
+ end (progn (end-of-defun) (point))
+ beg (progn (beginning-of-defun) (point)))
(goto-char beg)
(when (looking-at "^sub\\s +\\(.+\\_>\\)")
- (let* ((sub (match-string 1))
- (sepia-eval-package
- (sepia-guess-package sub (buffer-file-name)))
- (body (buffer-substring-no-properties beg end))
- (sepia-eval-file (buffer-file-name))
- (sepia-eval-line (line-number-at-pos beg)))
- (sepia-eval (if sepia-eval-defun-include-decls
- (concat
- (apply #'concat (xref-mod-decls sepia-eval-package))
- body)
- body))
- (xref-redefined sub sepia-eval-package)
- (message "Defined %s" sub))))))
+ (setq sub (match-string 1))
+ (let ((body (buffer-substring-no-properties beg end)))
+
+ (setq sepia-eval-package (sepia-guess-package sub (buffer-file-name))
+ sepia-eval-file (buffer-file-name)
+ sepia-eval-line (line-number-at-pos beg)
+ res
+ (sepia-eval-raw
+ (if sepia-eval-defun-include-decls
+ (concat
+ (apply #'concat (xref-mod-decls sepia-eval-package))
+ body)
+ body))))))
+ (if (cdr res)
+ (progn
+ (when (string-match " line \\([0-9]+\\), near \"\\([^\"]*\\)\""
+ (cdr res))
+ (goto-char beg)
+ (beginning-of-line (parse-integer (match-string 1 (cdr res))))
+ (search-forward (match-string 2 (cdr res))
+ (sepia-eol-from (point)) t))
+ (message "Error: %s" (cdr res)))
+ (xref-redefined sub sepia-eval-package)
+ (message "Defined %s" sub))))
+
+;;;###autoload
+(defun sepia-eval-expression (expr &optional list-p message-p)
+ "Evaluate EXPR in scalar context."
+ (interactive (list (read-string "Expression: ") current-prefix-arg t))
+ (let ((res (sepia-eval expr (if list-p 'list-context 'scalar-context))))
+ (when message-p (message "%s" res))
+ res))
(defun sepia-extract-def (file line obj mod)
(with-current-buffer (find-file-noselect (expand-file-name file))
@@ -1158,33 +1269,29 @@ With prefix arg, replace the region with the result."
(buffer-substring (point)
(progn (end-of-defun) (point)))))))
-(defun sepia-eval-no-run (string &optional discard collect-warnings)
- (condition-case err
- (sepia-eval
- (concat "\nBEGIN { use B; B::minus_c(); $^C=1; } { "
- string
- "}\nBEGIN { die \"ok\\n\" }")
- discard collect-warnings)
- (perl-error (if (string-match "^ok\n" (cadr err))
- nil
- (cadr err)))
- (error err)))
+(defun sepia-eval-no-run (string)
+ (let ((res (sepia-eval-raw
+ (concat "eval q#{ BEGIN { use B; B::minus_c(); $^C=1; } do { "
+ string
+ " };BEGIN { die \"ok\\n\" }#, $@"))))
+ (if (string-match "^ok\n" (car res))
+ nil
+ (car res))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REPL
(defvar sepia-eval-file nil
- "File in which ``sepia-eval'' evaluates perl expressions.")
+ "File in which `sepia-eval' evaluates perl expressions.")
(defvar sepia-eval-line nil
- "Line at which ``sepia-eval'' evaluates perl expressions.")
-
-;;;###autoload
-(defun sepia-interact ()
- "Start or switch to a perl interaction buffer."
- (interactive)
- (pop-to-buffer (get-buffer "*perl-interaction*")))
+ "Line at which `sepia-eval' evaluates perl expressions.")
(defun sepia-set-cwd (dir)
+ "Set the inferior Perl process's working directory to DIR.
+
+When called interactively, the current buffer's
+`default-directory' is used."
+ (interactive (list default-directory))
(sepia-call "Cwd::chdir" dir))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1197,37 +1304,48 @@ With prefix arg, replace the region with the result."
(defun sepia-doc-scan-buffer ()
(save-excursion
(goto-char (point-min))
- (loop while (re-search-forward
+ (loop
+ while (re-search-forward
"^=\\(item\\|head[2-9]\\)\\s +\\([%$&@A-Za-z_].*\\)" nil t)
- if (ignore-errors
- (let* ((s1 (match-string 2))
- (s2 (let ((case-fold-search nil))
- (replace-regexp-in-string
- "[A-Z]<\\([^>]+\\)>" "\\1" s1)))
- (longdoc
+ if
+ (ignore-errors
+ (let ((short (match-string 2)) longdoc)
+ (setq short
+ (let ((case-fold-search nil))
+ (replace-regexp-in-string
+ "E<lt>" "<"
+ (replace-regexp-in-string
+ "E<gt>" ">"
+ (replace-regexp-in-string
+ "[A-DF-Z]<\\([^<>]+\\)>" "\\1" short)))))
+ (while (string-match "^\\s *[A-Z]<\\(.*\\)>\\s *$" short)
+ (setq short (match-string 1 short)))
+ (setq longdoc
(let ((beg (progn (forward-line 2) (point)))
(end (1- (re-search-forward "^=" nil t))))
(forward-line -1)
(goto-char beg)
(if (re-search-forward "^\\(.+\\)$" end t)
- (concat s2 ": "
+ (concat short ": "
(substring-no-properties
(match-string 1)
0 (position ?. (match-string 1))))
- s2))))
+ short)))
(cond
;; e.g. "$x -- this is x"
((string-match "^[%$@]\\([A-Za-z0-9_:]+\\)\\s *--\\s *\\(.*\\)"
- s2)
- (list 'variable (match-string-no-properties 1 s2)
- (or (and (equal s2 (match-string 1 s2)) longdoc) s2)))
+ short)
+ (list 'variable (match-string-no-properties 1 short)
+ (or (and (equal short (match-string 1 short)) longdoc)
+ short)))
;; e.g. "C<foo(BLAH)>" or "$x = $y->foo()"
- ((string-match "\\([A-Za-z0-9_:]+\\)\\s *\\(\\$\\|(\\)" s2)
- (list 'function (match-string-no-properties 1 s2)
- (or (and (equal s2 (match-string 1 s2)) longdoc) s2)))
+ ((string-match "\\([A-Za-z0-9_:]+\\)\\s *\\(\\$\\|(\\)" short)
+ (list 'function (match-string-no-properties 1 short)
+ (or (and (equal short (match-string 1 short)) longdoc)
+ short)))
;; e.g. "$x this is x" (note: this has to come last)
- ((string-match "^[%$@]\\([^( ]+\\)" s2)
- (list 'variable (match-string-no-properties 1 s2) longdoc)))))
+ ((string-match "^[%$@]\\([^( ]+\\)" short)
+ (list 'variable (match-string-no-properties 1 short) longdoc)))))
collect it)))
(defun sepia-buffer-package ()
@@ -1250,11 +1368,18 @@ used for eldoc feedback."
(puthash (second x) (third x) map)
(puthash (concat pack (second x)) (third x) map)))))
+(defun sepia-looks-like-module (obj)
+ (let (case-fold-search)
+ (or (string-match "^\\([A-Z].*::\\)?[A-Z]+[A-Za-z0-9]+\\sw*$" obj)
+ (string-match
+ (eval-when-compile (regexp-opt '("strict" "vars" "warnings" "lib")))
+ obj))))
+
(defun sepia-symbol-info (&optional obj type)
"Eldoc function for Sepia-mode.
-Looks in ``sepia-doc-map'' and ``sepia-var-doc-map'', then tries
-calling ``cperl-describe-perl-symbol''."
+Looks in `sepia-doc-map' and `sepia-var-doc-map', then tries
+calling `cperl-describe-perl-symbol'."
(unless obj
(multiple-value-bind (ty ob) (sepia-ident-at-point)
(setq obj (if (consp ob) (car ob) ob)
@@ -1263,7 +1388,9 @@ calling ``cperl-describe-perl-symbol''."
(or (gethash obj (ecase (or type ?&)
(?& sepia-doc-map)
((?$ ?@ ?%) sepia-var-doc-map)
- (nil sepia-module-doc-map)))
+ (nil sepia-module-doc-map)
+ (?* sepia-module-doc-map)
+ (t (error "sepia-symbol-info: %s" type))))
;; Loathe cperl a bit.
(flet ((message (&rest blah) (apply #'format blah)))
(let* (case-fold-search
@@ -1277,12 +1404,7 @@ calling ``cperl-describe-perl-symbol''."
(concat (substring hlp 0 72) "...")
hlp))
;; Try to see if it's a module
- (if (or (string-match "^\\([A-Z].*::\\)?[A-Z]+[a-z]+\\sw*$" obj)
- (string-match (eval-when-compile
- (regexp-opt '("strict"
- "vars"
- "warnings"
- "lib"))) obj))
+ (if (sepia-looks-like-module obj)
(sepia-core-version obj)
""))))
"")))
@@ -1311,7 +1433,7 @@ calling ``cperl-describe-perl-symbol''."
(defun sepia-goto-error-at (pos)
"Visit the source of the error on line at point."
(interactive "d")
- (ifa (sepia-extract-next-warning (my-bol-from pos) (my-eol-from pos))
+ (ifa (sepia-extract-next-warning (sepia-bol-from pos) (sepia-eol-from pos))
(destructuring-bind (file line msg) it
(find-file file)
(goto-line line)
@@ -1323,7 +1445,7 @@ calling ``cperl-describe-perl-symbol''."
(interactive "r")
(goto-char beg)
(let ((msgs nil))
- (loop for w = (sepia-extract-next-warning (my-bol-from (point)) end)
+ (loop for w = (sepia-extract-next-warning (sepia-bol-from (point)) end)
while w
do (destructuring-bind (file line msg) w
(push (format "%s:%d:%s\n" (abbreviate-file-name file) line msg)
diff --git a/sepia.texi b/sepia.texi
new file mode 100644
index 0000000..3bdfd83
--- /dev/null
+++ b/sepia.texi
@@ -0,0 +1,705 @@
+\input texinfo @c -*-texinfo-*-
+ at c %**start of header
+ at setfilename sepia.info
+ at settitle SEPIA: Simple Emacs Perl Integration
+ at dircategory Emacs
+ at direntry
+* Sepia: (sepia). Simple Emacs Perl Integration.
+ at end direntry
+ at c %**end of header
+
+ at titlepage
+ at title Sepia: Simple Emacs Perl Integration
+ at author Sean O'Rourke
+ at end titlepage
+
+ at macro kbinding{key,cmd}
+ at item \key\ `\cmd\'
+ at kindex \key\
+ at end macro
+
+ at macro fitem{name}
+ at item \name\
+ at findex \name\
+ at end macro
+
+ at macro xxx{stuff}
+ at b{XXX: \stuff\}
+ at end macro
+
+ at node Top, Introduction, (dir), (dir)
+
+ at ifinfo
+ at top SEPIA
+ at end ifinfo
+
+ at ifhtml
+ at image{Sepia,,,,jpg}
+ at end ifhtml
+
+Sepia is a set of Perl development tools for Emacs supporting code
+navigation and interactive evaluation.
+
+ at menu
+* Introduction::
+* Editing::
+* Interactive Perl::
+* Customization::
+* Internals::
+* Credits::
+* Function Index::
+ at end menu
+
+ at c ============================================================
+ at node Introduction, Editing, Top, Top
+ at chapter Introduction
+
+Sepia is a set of tools for Perl development in Emacs. Its goal is to
+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.
+
+ at menu
+* Getting Started::
+* Philosophy::
+ at end menu
+
+ at node Getting Started, Philosophy, Introduction, Introduction
+ at section Getting Started
+
+To install Sepia, its Emacs Lisp files must be in Emacs'
+ at code{load-path}, and the @file{lib} directory must be in Perl's
+ at code{@@INC}. Assuming that Sepia has been unpacked in
+ at file{~/sepia}, it can be installed by adding the following lines to
+ at file{~/.emacs}:
+
+ at example
+(add-to-list 'load-path "~/sepia")
+(setq sepia-perl5lib (list (expand-file-name "~/sepia/lib")))
+(defalias 'perl-mode 'sepia-mode)
+(require 'sepia)
+ at end example
+
+Then to bring up the interactive Perl prompt, type @kbd{M-x sepia-repl}.
+
+ at node Philosophy, , Getting Started, Introduction
+ at section Philosophy
+
+A development environment should support three activities: code
+spelunking, interaction, and customization. Emacs as an environment for
+developing Emacs Lisp thoroughly supports all of them: It has commands
+to visit individual functions' code and documentation, commands to
+evaluate or step through expressions, and an architecture that
+encourages customization in Emacs Lisp. As an environment for Perl,
+however, it is lacking: there is limited interactivity with the Perl
+debugger, and reasonable documentation browsing, but no support for
+navigating, editing, and re-evaluating code. Sepia attempts to remedy
+the situation.
+
+Modern IDEs also support these three activities, but do so awkwardly.
+Rather than having functions to visit definitions (@kbd{find-function})
+and search for functions (@kbd{apropos}), they clutter the screen with
+class and file trees. Rather than supporting interactive evaluation of
+small pieces of code, they perform background semantic checking on whole
+projects and highlight errors. Rather than allowing minor
+customizations to grow organically into features, they support limited
+configuration files and baroque plug-in APIs. Sepia tries to adhere to
+the apparent Emacs philosophy that rich semantic information should be
+unobtrusive, and that the best way to build working code is to start
+by experimenting with small pieces.
+
+Language support packages for Emacs vary widely in the degree to which
+they make use of or replace existing Emacs features. Minimal modes
+provide keyword-based syntax highlighting and an unadorned comint buffer
+as an interpreter. Others provide their own specialized equivalents of
+comint, eldoc, completion, and other Emacs features. Sepia takes a
+third approach by trying to do as much as possible with existing Emacs
+features, even when they are not optimal for Perl. For example, it uses
+comint to communicate with the subprocess, eldoc to display
+documentation, and grep to list source locations.
+
+This approach has three advantages: First, it maximizes the number of
+features that can be supported with limited development time. Second,
+it respects users' settings. A seasoned Emacs user may have changed
+hundreds of settings, so a mode that reimplements features will have to
+support equivalent settings, and will force the user to re-specify them.
+Finally, this approach respects decades of development spent, as Neal
+Stephenson put it, ``focused with maniacal intensity on the deceptively
+simple-seeming problem of editing text.'' Many non-obvious choices go
+into making a polished interface, and while a reimplementation gets rid
+of accumulated cruft, it must rediscover these hidden trade-offs.
+
+Anyways, I hope you enjoy using Sepia. Its development style is strange
+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.
+
+ at c ============================================================
+ at node Editing, Interactive Perl, Introduction, Top
+ at chapter Editing
+ at findex sepia-mode
+
+Sepia's first contribution is a set of commands to explore a Perl
+codebase. These include commands to browse and display documentation,
+to find function definitions, and to query a cross-reference database of
+function and variable uses. Sepia also provides intelligent symbol
+completion.
+
+ at menu
+* Completion::
+* Navigation::
+* Documentation::
+ at end menu
+
+ at node Completion, Navigation, Editing, Editing
+ at section Completion
+
+Sepia implements partial-word completion that communicates with the
+inferior Perl process. For example, @samp{%S:X:v_u} completes to
+ at samp{%Sepia::Xref::var_use} when Sepia is loaded. This completion only
+operates on functions and global variables known to the Perl
+interpreter, so it works best when code and interpreter are in sync.
+
+More precisely, completion examines the text before point and tries each
+of the following in turn, using the first successful approach:
+
+ at enumerate
+ at item
+If the text looks like a method call (e.g. @samp{$object->f} or
+ at samp{Class->f}), complete on methods.
+
+ at item
+If it looks like a variable (e.g. @samp{%hash} or @samp{$scalar}),
+complete on variables.
+
+ at item
+Complete on modules and functions.
+
+ at item
+Otherwise, complete on Perl built-in operators.
+ at end enumerate
+
+For each of the first three cases, completions candidates are first
+generated by splitting the text on characters @code{[:_]} and matching
+the resulting word parts. For example, @samp{X:a_b} will complete to
+all symbols matching @samp{^X[^:]*:+a[^:_]*_b} such as @samp{Xref::a_bug}
+and @samp{X::always_bites_me}. If no matches result, the text is
+treated as an acronym. For example, @samp{dry} will complete to
+ at samp{dont_repeat_yourself}.
+
+Completion is performed by the following commands:
+ at table @kbd
+ at item M-x sepia-complete-symbol
+ at findex sepia-complete-symbol
+Complete the symbol before point as described above. Note that this
+does not consider lexical scope, and is always case-sensitive,
+independent of @code{completion-ignore-case}.
+
+ at item TAB
+ at itemx M-x sepia-indent-or-complete
+ at findex sepia-indent-or-complete
+First try to reindent the current line. If its indentation does not
+change, then try to expand an abbrev at point (unless
+ at code{sepia-indent-expand-abbrev} is @code{nil}). If no abbrev is
+expanded, then call @code{sepia-complete-symbol}.
+
+ at end table
+
+ at node Navigation, Documentation, Completion, Editing
+ at section Navigation
+
+Sepia provides several commands for navigating program source. All of
+them rely on information from the inferior Perl process, so it is
+important both that it be running, and that its internal representation
+of the program match the program source. The commands marked (Xref)
+below also rely on a cross-reference database, which must be explicitly
+rebuilt by calling @code{xref-rebuild} when the program changes.
+
+There are two basic kinds of navigation commands. The first kind jumps
+directly to the first matching location when possible, prompting only if
+no such location is found. These commands find only a single location.
+
+ at c direct-jump commands
+ at table @kbd
+
+ at item M-. M-.
+ at itemx M-x sepia-dwim
+ at findex sepia-dwim
+Guess what kind of identifier is at point, and try to do the right
+thing: for a function, find its definition(s); for a variable, find its
+uses; for a module, view its documentation; otherwise, prompt for the
+name of a function to visit. @code{sepia-dwim} automatically goes to
+the first function definition or variable use found.
+
+ at item M-. l
+ at itemx M-x sepia-location
+ at findex sepia-location
+Jump directly to the definition of the function at point, prompting if
+point is not on a known function. If multiple definitions are found,
+choose one arbitrarily. This function is similar to @code{sepia-defs},
+and the two should probably be merged.
+
+ at item M-. j
+ at itemx M-x sepia-jump-to-symbol
+ at findex sepia-jump-to-symbol
+Navigate to a function using ``ido'' interactive completion. Within
+interactive completion, press @key{:} to descend into a package,
+ at key{DEL} to ascend to a parent package, and @key{RET} to go to the
+currently-selected function.
+
+ at end table
+
+The second kind of navigation commands always prompts the user -- though
+usually with a sensible default value -- and finds multiple locations.
+When called with a prefix argument, these commands present their results
+in a @code{grep-mode} buffer. When called @emph{without} a prefix
+argument, they place all results on the found-location ring and jump
+directly to the first. The remaining locations can be cycled through by
+calls to @code{sepia-next}.
+
+ at c prompt-and-go commands
+ at table @kbd
+ at item M-. f @var{name} @key{RET}
+ at itemx M-x sepia-defs
+ at findex sepia-defs
+Find definition(s) of function @var{name}.
+
+ at item M-. m @var{name} @key{RET}
+ at itemx M-x sepia-module-find @var{name} @key{RET}
+ at findex sepia-module-find
+Find the source of module @var{name}.
+
+ at item M-. a @var{regexp} @key{RET}
+ at itemx M-x sepia-apropos @var{regexp} @key{RET}
+ at findex sepia-apropos
+Find definitions of all functions whose names match @var{regexp}.
+
+ at item M-. c @var{name} @key{RET}
+ at itemx M-x sepia-callers @var{name} @key{RET}
+ at findex sepia-callers
+(Xref) Find calls to function @var{name}.
+
+ at item M-. C @var{name} @key{RET}
+ at itemx M-x sepia-callees @var{name} @key{RET}
+ at findex sepia-callees
+(Xref) Find the definitions of functions called by @var{name}.
+
+ at item M-. v @var{name} @key{RET}
+ at itemx M-x sepia-var-uses @var{name} @key{RET}
+ at findex sepia-var-uses
+(Xref) Find uses of the global variable @var{name}.
+
+ at item M-. V @var{name} @key{RET}
+ at itemx M-x sepia-var-defs @var{name} @key{RET}
+ at findex sepia-var-defs
+(Xref) Find definitions of global variable @var{name}. Since Perl's
+global variables are not declared, this is rarely useful
+
+ at c XXX: broken, so don't mention it.
+ at c @item M-. A @var{regexp} @key{RET}
+ at c @itemx M-x sepia-var-apropos
+ at c @findex sepia-var-apropos
+ at c Find definitions of all variables whose names match @var{regexp}. Since
+ at c this function does not handle lexical variables, and since Perl's global
+ at c variables are not declared, this is rarely useful.
+
+ at end table
+
+Finally, there are several other navigation-related commands that do not
+fit into either of the above categories.
+
+ at c other commands
+ at table @kbd
+ at item M-,
+ at itemx M-x sepia-next
+ at findex sepia-next
+Cycle through the definitions found by the previous @key{M-.} search.
+
+ at item M-. r
+ at itemx M-x sepia-rebuild
+ at findex sepia-rebuild
+Rebuild the cross-reference database by walking the op-tree and
+stashes.
+
+ at item M-. t
+ at itemx M-x find-tag
+Execute the @code{find-tag} command typically bound to @key{M-.}.
+
+ at end table
+
+ at node Documentation, , Navigation, Editing
+ at section Documentation
+
+Sepia can be used to browse installed modules' documentation, to format
+and display the current buffer's POD, and to browse the list of modules
+installed on the system.
+
+ at table @kbd
+ at item M-. d @var{name} @key{RET}
+ at itemx M-x sepia-perldoc-this
+ at findex sepia-perldoc-this
+View documentation for module @var{name} or Perl manual page @var{name}.
+
+ at item C-c C-d
+ at itemx M-x sepia-view-pod
+ at findex sepia-view-pod
+Format and view the current buffer's documentation.
+
+ at item sepia-package-list
+ at findex sepia-package-list
+Browse a tree of installed packages. This lists only the top-level
+packages from installed distributions, so if package @code{My::Stuff}
+also provides @code{My::Stuff::Details}, it will not be displayed. When
+Emacs-w3m is available, each module is linked to its documentation.
+
+ at item sepia-module-list
+ at findex sepia-module-list
+Browse a tree of both top-level and internal packages, like
+ at code{sepia-package-list}.
+
+ at end table
+
+ at findex sepia-install-eldoc
+Sepia also integrates with eldoc (at least in GNU Emacs >= 22).
+Documentation for Perl operators and control structures is taken from
+CPerl mode. Sepia will also display documentation for user-defined
+functions if their POD is formatted in the standard way, with functions
+described in a ``=head2'' or ``=item'' entry. To load user
+documentation, visit the relevant file and type @kbd{M-x
+sepia-doc-update}.
+
+If @code{Module::CoreList} is available, Sepia's eldoc function will
+also display the first version of Perl with which a module was shipped.
+This is intended to give the programmer a sense of when he is creating
+external dependencies.
+
+ at c ============================================================
+ at node Interactive Perl, Customization, Editing, Top
+ at chapter Interactive Perl
+
+ at findex sepia-repl
+Sepia's second main contribution is an interactive interface (REPL) to
+an inferior Perl process. The interface is based on GUD mode, and
+inherits many of its bindings; this chapter discusses only the Sepia
+extensions. To start or switch to the repl, type @kbd{M-x sepia-repl}.
+As in Sepia mode, @key{TAB} in the REPL performs partial-word completion
+with @code{sepia-complete-symbol}.
+
+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.
+
+ at menu
+* Shortcuts::
+* Debugger::
+* Evaluation::
+* Mutilation::
+* Scratchpad::
+ at end menu
+
+ at node Shortcuts, Debugger, Interactive Perl, Interactive Perl
+ at section Shortcuts
+
+``Shortcuts'' are commands handled specially by the REPL rather than
+being evaluated as Perl code. They either communicate with the REPL
+function, or provide a convenient interface to variables in the Sepia
+package. Shortcuts are prefixed by a comma (@key{,}), and may be
+abbreviated to the shortest unique prefix.
+
+ at table @kbd
+ at item cd @var{dir}
+Change Perl's current directory to @var{dir}.
+
+ at item format @var{type}
+Set the output format to @var{type}, either ``dumper'' (using
+ at code{Data::Dumper}), ``dump'' (@code{Data::Dump}), ``yaml''
+(@code{YAML}), or ``plain'' (stringification). Default: ``dumper''.
+
+ at item help
+Display a list of shortcuts.
+
+ at item methods @var{name} [@var{regexp}]
+Display a list of functions defined in package @var{name} and its
+ at code{ISA}-ancestors matching optional pattern @var{regexp}.
+
+ at item package @var{name}
+Set the default evaluation package to @var{name}.
+
+ at item quit
+Exit the inferior Perl process.
+
+ at item reload
+Reload @file{Sepia.pm} and recursively invoke the REPL. This command is
+mostly of interest when working on Sepia itself.
+
+ at item shell [@var{command}]
+Execute shell command @var{command}, displaying its standard output and
+standard error.
+
+ at item strict [@var{val}]
+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 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 end table
+
+ at node Debugger, Evaluation, Shortcuts, Interactive Perl
+ at section Debugger
+
+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
+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
+and modify lexical variables.
+
+The debugger has its own set of shortcuts, also prefixed by a comma.
+
+ at table @kbd
+ at item backtrace
+Show a backtrace.
+
+ at item break @var{file}:@var{line} [@var{expr}]
+Set a breakpoint in @var{file} at @var{line}. If @var{expr} is
+supplied, stop only if it evaluates to true.
+
+ at item down @var{n}
+ at itemx up @var{n}
+Move the current stack frame up or down by @var{n} (or one) frames.
+
+ at item inspect [@var{n}]
+Inspect lexicals in the current frame or frame @var{n}, counting upward
+from 1.
+
+ at item lsbreak
+List breakpoints.
+
+ at item next [@var{n}]
+Advance @var{n} (or one) lines, skipping subroutine calls.
+
+ at item quit
+ at itemx die
+ at itemx warn
+Continue as the program would have executed without debugger
+intervention, dying if the debugger was called from @code{die()}.
+
+ at item return @var{expr}
+Continue execution as if @code{die()} had returned the value of
+ at var{expr}, which is evaluated in the global environment.
+
+ at item step [@var{n}]
+Step forward @var{n} (or one) lines, descending into subroutines.
+
+ at end table
+
+ at node Evaluation, Mutilation, Debugger, Interactive Perl
+ at section Evaluation
+
+When interactive Perl is running, Sepia can evaluate regions of code in
+the inferior Perl process. The following commands assume that this
+process has already been started by calling @code{sepia-repl}.
+
+ at table @kbd
+ at item C-M-x
+ at itemx M-x sepia-eval-defun
+ at findex sepia-eval-defun
+Evaluate the function around point in the inferior Perl process. If it
+contains errors, jump to the location of the first.
+
+ at item C-c C-l
+ at itemx M-x sepia-load-file
+ at findex sepia-load-file
+Save the current buffer, then reload its file and if warnings or errors
+occur, display an error buffer. With a prefix argument, also rebuild
+the cross-reference index.
+
+ at item C-c e
+ at itemx M-x sepia-eval-expression @key{RET} @var{expr} @key{RET}
+ at findex sepia-eval-expression
+Evaluate @var{expr} in scalar context and echo the result. With a
+prefix argument, evaluate in list context.
+
+ at item C-c!
+ at itemx sepia-set-cwd
+Set the REPL's working directory to the current buffer's directory.
+
+ at end table
+
+ at node Mutilation, Scratchpad, Evaluation, Interactive Perl
+ at section Mutilation
+
+Sepia contains several functions to operate on regions of text using the
+interactive Perl process. These functions can be used like standard
+one-liners (e.g. @samp{perl -pe ...}), with the advantage that all of
+the functions and variables in the interactive session are available.
+
+ at table @kbd
+ at item M-x sepia-perl-pe-region @key{RET} @var{code} @key{RET}
+ at findex sepia-perl-pe-region
+Evaluate @var{code} on each line in the region with @code{$_} bound to
+the line text, collecting the resulting values of @code{$_}. With a
+prefix argument, replace the region with the result.
+
+ at item M-x sepia-perl-ne-region @key{RET} @var{code} @key{RET}
+ at findex sepia-perl-ne-region
+Evaluate @var{code} as above, but collect the results instead.
+
+ at item M-x sepia-perlize-region @key{RET} @var{code} @key{RET}
+ at findex sepia-perlize-region
+Evaluate @var{code} once with @code{$_} bound to the entire region,
+collecting the final value of @code{$_}. With a prefix argument,
+replace the region.
+
+ at end table
+
+ at node Scratchpad, , Mutilation, Interactive Perl
+ at section Scratchpad
+
+ at findex sepia-scratch
+Sepia also supports a scratchpad, another form of interaction inspired
+by Emacs' @code{*scratch*} buffer. To create or switch to the
+scratchpad, type @kbd{M-x sepia-scratch}. Scratchpad mode is exactly
+like Sepia mode, except @key{C-j} evaluates the current line and prints
+the result on the next line.
+
+ at c ============================================================
+ at node Customization, Internals, Interactive Perl, Top
+ at 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.
+
+ at menu
+* Emacs Variables::
+* Perl Variables::
+ at end menu
+
+ at node Emacs Variables, Perl Variables, Customization, Customization
+ at section Emacs Variables
+
+ at table @kbd
+
+ at item sepia-complete-methods
+If non- at code{nil}, @code{sepia-complete-symbol} will complete
+simple method calls of the form @code{$x->} or @code{Module->}. Since
+the former requires evaluation of @code{$x}, this can be disabled.
+Default: @code{T}.
+
+ at item sepia-eval-defun-include-decls
+If non- at code{nil}, attempt to generate a declaration list for
+ at code{sepia-eval-defun}. This is necessary when evaluating some code,
+such as that calling functions without parentheses, because the presence
+of declarations affects the parsing of barewords. Default: @code{T}.
+
+ at item sepia-indent-expand-abbrev
+If non- at code{nil}, @code{sepia-indent-or-complete} will, if
+reindentation does not change the current line, expand an abbreviation
+before point rather than performing completion. Only if no abbreviation
+is found will it perform completion. Default: @code{T}.
+
+ at item sepia-module-list-function
+The function to view a tree of installed modules. Default:
+ at code{w3m-find-file} if Emacs-w3m is installed, or
+ at code{browse-url-of-buffer} otherwise.
+
+ at item sepia-perldoc-function
+The function called to view installed modules' documentation. Default:
+ at code{w3m-perldoc} if Emacs-w3m is installed, or @code{cperl-perldoc}
+otherwise.
+
+ at item sepia-perl5lib
+A list of directories to include in @code{PERL5LIB} when starting
+interactive Perl. Default: @code{nil}.
+
+ at item sepia-prefix-key
+The prefix to use for for functions in @code{sepia-keymap}. Default:
+ at key{M-.}.
+
+ at item sepia-program-name
+The Perl program name for interactive Perl. Default: ``perl''.
+
+ at item sepia-use-completion
+If non- at code{nil}, various Sepia functions will generate completion
+candidates from interactive Perl when called interactively. This may be
+slow or undesirable in some situations. Default: @code{T}.
+
+ at item sepia-view-pod-function
+The function called to view the current buffer's documentation.
+Default: @code{sepia-w3m-view-pod} if Emacs-w3m is available, or
+ at code{sepia-perldoc-buffer} otherwise.
+
+ at end table
+
+ at node Perl Variables, , Emacs Variables, Customization
+ at section Perl Variables
+
+The following variables in the Sepia package control various aspects of
+interactive evaluation.
+
+ at table @code
+
+ at item $PACKAGE
+The package in which user input is evaluated, determined automatically
+when code is evaluated from a buffer. Default: @code{main}.
+
+ at item $PRINTER
+The function called to format interactive output, normally set with the
+ at code{printer} shortcut.
+
+ at item $PRINT_PRETTY
+If true, format some values nicely independent of the value of
+ at code{$PRINTER}. Currently, this means columnating lists of simple
+scalars. Default: true.
+
+ at item $PS1
+The trailing end of the prompt string, which should end with ``> ''.
+Default: @code{"> "}.
+
+ at item $STOPDIE
+If true, calls to @code{die} from interactive code will invoke the Sepia
+debugger. Default: true.
+
+ at item $STOPWARN
+If true, calls to @code{warn} from interactive code will invoke the
+Sepia debugger. Default: false.
+
+ at item $WANTARRAY
+If true, evaluate interactive expressions in list context. Default: true.
+
+ at end table
+
+ at c ============================================================
+ at node Internals, Credits, Customization, Top
+ at chapter Internals
+
+Many things remain unexplained except by the code itself, and some
+details mentioned above should probably be given less prominence. For
+developer documentation, please see the POD for @code{Sepia} and
+ at code{Sepia::Xref}, and the doc-strings in @file{sepia.el}.
+
+ at node Credits, Function Index, Internals, Top
+ at 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.
+
+I would also like to thank the authors of Emacs-w3m, SLIME, ido, and
+B::Xref for the code I stole.
+
+ at c ============================================================
+ at node Function Index, , Credits, Top
+ at unnumbered Function Index
+ at printindex fn
+
+ at bye
diff --git a/test.pl b/t/01basic.t
similarity index 78%
rename from test.pl
rename to t/01basic.t
index c11e049..cb52d2c 100644
--- a/test.pl
+++ b/t/01basic.t
@@ -4,6 +4,7 @@ use Test::Simple tests => 18;
require Data::Dumper;
require Sepia;
require Sepia::Xref;
+require Sepia::Debug;
ok(1, 'loaded');
Sepia::Xref::rebuild();
@@ -43,14 +44,18 @@ 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);
-if (exists $INC{'Module/Info.pm'}) {
+ ## 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 = ('B', 'Carp', 'Cwd', 'Exporter', 'Module::Info',
- 'Scalar::Util', 'Text::Abbrev', 'strict', 'vars');
+ 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)");
+ 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');
} else {
diff --git a/t/50expect.t b/t/50expect.t
new file mode 100644
index 0000000..91955e2
--- /dev/null
+++ b/t/50expect.t
@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+
+BEGIN {
+ eval 'use Test::Expect';
+ if ($@) {
+ print "# requires Test::Expect\n1..1\nok 1\n";
+ exit 0;
+ } else {
+ eval 'use Test::Simple tests => 34';
+ }
+}
+
+use FindBin '$Bin';
+use Sepia;
+use Sepia::Xref;
+
+expect_run
+ command => "$^X -Mblib -MSepia -MSepia::Xref -e 'Sepia::repl(\\*STDIN, \\*STDOUT)'",
+ prompt => [-re => 'main @[^>]*> '],
+ quit => ',quit';
+expect_handle()->log_file('/tmp/b') if $ENV{USER} eq 'seano';
+
+expect ",help",
+q!REPL commands (prefixed with ','):
+ break [F:N [E]] Set a breakpoint in F at line N (or at current
+ position), enabled if E evalutes to true.
+ cd DIR Change directory to DIR
+ debug [0|1] Enable or disable debugging.
+ delete Delete current breakpoint.
+ format [dumper|dump|yaml|plain]
+ Set output formatter (default: dumper)
+ help Display this message
+ lsbreak List breakpoints.
+ methods X [RE] List methods for reference or package X,
+ matching optional pattern RE.
+
+ package PACKAGE Set evaluation package to PACKAGE
+ quit Quit the REPL
+ reload Reload Sepia.pm and relaunch the REPL.
+ shell CMD ... Run CMD in the shell.
+ strict [0|1] Turn 'use strict' mode on or off
+ wantarray [0|1] Set or toggle evaluation context
+ who PACKAGE [RE] List variables and subs in PACKAGE matching optional
+ pattern RE.!
+ if 0;
+
+expect ",wh Sepia::Xref xref",
+'xref xref_definitions xref_main
+xref_cv xref_exclude xref_object ';
+
+expect_send '{ package A; sub a {}; package X; @ISA = qw(A); sub x {} };';
+expect ",wh X", '@ISA x', 'package list';
+expect ",me X", 'a x', 'methods 1';
+
+expect '$x = bless {}, X;', '$x = bless {}, X;'; # XXX: stupid expect.
+expect ',me $x', ",me \$x\na x", 'methods 2'; # XXX: stupid expect.
+
+######################################################################
+## Debugger
+expect ',lsb', '';
+expect_send ',debug 1';
+expect_send "do '$Bin/testy.pl';", 'get testy';
+
+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 ',in',
+'[3] DB::DB:
+ $n = \3', 'munged';
+expect ',del', '';
+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/error: asdf/, 'saw die message';
diff --git a/t/testy.pl b/t/testy.pl
new file mode 100644
index 0000000..6dae3be
--- /dev/null
+++ b/t/testy.pl
@@ -0,0 +1,18 @@
+sub fib1 {
+ my $n = shift;
+ if ($n < 2) {
+ return $n
+ } else {
+ return fib1($n-1) + fib1($n-2)
+ }
+}
+
+sub fib2 {
+ my $n = shift;
+ die "asdf\n" if $n <= 0;
+ if ($n < 2) {
+ return $n
+ } else {
+ return fib2($n-1) + fib2($n-2)
+ }
+}
--
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