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