From 56cc55af83d23d9ef5e2e3e9011f2922de84d210 Mon Sep 17 00:00:00 2001 From: seanorourke Date: Fri, 19 May 2006 05:09:37 +0000 Subject: [PATCH] Version 0.62 --- ChangeLog | 13 +++ Makefile | 18 ++-- README | 20 ++-- Sepia.pm | 322 +++++++++++++++++++++++++++++++++++++++++++++++++++++--------- sepia.el | 164 +++++++++++++++++++++----------- 5 files changed, 419 insertions(+), 118 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0204dca..6756c90 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2006-05-18 Sean O'Rourke + + * sepia.el, Sepia.pm: improved bulk-transfer protocol. + * Sepia.pm: override die with simple inspector/debugger. + * Sepia.pm: $__ and @__ now contain results of the last + expression. + * sepia.el, Sepia.pm: primitive support for evaluating elisp sent + from Perl. Turn on comint-use-prompt-regexp because the fields + stuff is flaky with this. + * sepia.el, Sepia.pm: ",cd" shortcut coordinates directory with + Emacs. + * VERSION 0.61, 0.62 + 2006-04-14 Sean O'Rourke * generic-repl.el: replaced by comint. diff --git a/Makefile b/Makefile index b25dcee..2d3cf87 100644 --- a/Makefile +++ b/Makefile @@ -13,7 +13,7 @@ # ABSTRACT => q[Simple Emacs-Perl InterAction] # AUTHOR => q[Sean O'Rourke ] # NAME => q[Sepia] -# PREREQ_PM => { Module::Info=>q[0], Data::Dumper=>q[0] } +# PREREQ_PM => { B::Module::Info=>q[0], Data::Dumper=>q[0] } # VERSION_FROM => q[Sepia.pm] # --- MakeMaker post_initialize section: @@ -53,11 +53,11 @@ AR_STATIC_ARGS = cr DIRFILESEP = / NAME = Sepia NAME_SYM = Sepia -VERSION = 0.59 +VERSION = 0.61 VERSION_MACRO = VERSION -VERSION_SYM = 0_59 +VERSION_SYM = 0_61 DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" -XS_VERSION = 0.59 +XS_VERSION = 0.61 XS_VERSION_MACRO = XS_VERSION XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" INST_ARCHLIB = blib/arch @@ -250,7 +250,7 @@ RCS_LABEL = rcs -Nv$(VERSION_SYM): -q DIST_CP = best DIST_DEFAULT = tardist DISTNAME = Sepia -DISTVNAME = Sepia-0.59 +DISTVNAME = Sepia-0.61 # --- MakeMaker macro section: @@ -443,12 +443,12 @@ metafile : $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META.yml $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META.yml $(NOECHO) $(ECHO) 'name: Sepia' >> META.yml - $(NOECHO) $(ECHO) 'version: 0.59' >> META.yml + $(NOECHO) $(ECHO) 'version: 0.61' >> META.yml $(NOECHO) $(ECHO) 'version_from: Sepia.pm' >> META.yml $(NOECHO) $(ECHO) 'installdirs: site' >> META.yml $(NOECHO) $(ECHO) 'requires:' >> META.yml + $(NOECHO) $(ECHO) ' B::Module::Info: 0' >> META.yml $(NOECHO) $(ECHO) ' Data::Dumper: 0' >> META.yml - $(NOECHO) $(ECHO) ' Module::Info: 0' >> META.yml $(NOECHO) $(ECHO) '' >> META.yml $(NOECHO) $(ECHO) 'distribution_type: module' >> META.yml $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.17' >> META.yml @@ -713,13 +713,13 @@ testdb_static :: testdb_dynamic # --- MakeMaker ppd section: # Creates a PPD (Perl Package Description) for a binary distribution. ppd: - $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' Simple Emacs-Perl InterAction' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' Sean O'\''Rourke <seano@cpan.org>' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd diff --git a/README b/README index 76bf3a5..94ba877 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -* DESCRIPTION (-*- allout -*- mode) +* DESCRIPTION (-*- org -*- mode) Sepia is a set of features to make Emacs a better tool for Perl development, including: @@ -54,23 +54,23 @@ you can then navigate. * TODO -.- (Easy) Use module, file, and line number to refine queries on the +** (Easy) Use module, file, and line number to refine queries on the Perl side. -.- (Hard) Use module, file, and line number to filter results on the +** (Hard) Use module, file, and line number to filter results on the Emacs side. -.- (Easy) Clean up Perl side a bit more. -.- (Medium) Better documentation for Elisp side. -.- (Medium) Get the variable def/use analysis working again. +** (Easy) Clean up Perl side a bit more. +** (Medium) Better documentation for Elisp side. +** (Medium) Get the variable def/use analysis working again. * BUGS -.- Function definition lines may occasionally all go completely wrong. +** Function definition lines may occasionally all go completely wrong. Rebuilding the Xref database fixes this. -.- The cursor may miss by several lines when jumping to a definition. +** The cursor may miss by several lines when jumping to a definition. This is hard to fix -- Perl doesn't give exact line numbers for sub defs, so we have to do some minor regex-searching. -.- `sepia-var-assigns' doesn't work yet -- don't use it. -.- named method calls are (mostly?) detected, but nothing smart is +** `sepia-var-assigns' doesn't work yet -- don't use it. +** named method calls are (mostly?) detected, but nothing smart is done about packages, so e.g. "new Foo" will result in listings for every instance of "new" in your program. diff --git a/Sepia.pm b/Sepia.pm index ef8bc6a..18f479a 100644 --- a/Sepia.pm +++ b/Sepia.pm @@ -1,13 +1,15 @@ package Sepia; -our $VERSION = '0.60'; +$VERSION = '0.62'; +@ISA = qw(Exporter); require Exporter; -our @ISA = qw(Exporter); - use strict; use Cwd 'abs_path'; use Scalar::Util 'looks_like_number'; use Module::Info; +use PadWalker qw(peek_my peek_our peek_sub closed_over); +use Sub::Uplevel; +use Carp; use B; =item C<@compls = completions($string [, $type])> @@ -18,7 +20,6 @@ e.g. "S:m_w" completes to "Sepia::my_walksymtable". =cut - sub _apropos_re($) { # Do that crazy multi-word identifier completion thing: @@ -98,7 +99,7 @@ sub location my $str = $_; if (my ($pfx, $name) = $str =~ /^([\%\$\@]?)(.+)/) { if ($pfx) { - print STDERR "Sorry -- can't lookup variables."; + warn "Sorry -- can't lookup variables."; []; } else { # XXX: svref_2object only seems to work with a package @@ -119,7 +120,7 @@ sub location my ($shortname) = $name =~ /^(?:.*::)([^:]+)$/; [Cwd::abs_path($file), $line, $shortname || $name] } else { - print STDERR "Bad CV for $name: $cv"; + warn "Bad CV for $name: $cv"; []; } } @@ -295,9 +296,9 @@ sub tolisp($) my $t = ref $thing; if (!$t) { if (looks_like_number $thing) { - 0+$thing; + ''.$thing; } else { - '"'.$thing.'"'; + qq{"$thing"}; } } elsif ($t eq 'GLOB') { (my $name = $$thing) =~ s/\*main:://; @@ -316,75 +317,310 @@ sub tolisp($) } } +=item C + +Print C<@res> appropriately on the current filehandle. If C<$iseval> +is true, use terse format. Otherwise, use human-readable format. + +=cut + sub printer { no strict; local *res = shift; - my $marker = shift; - if ($marker) { - print "\n$marker\n@res\n$marker\n"; + my ($iseval, $wantarray) = @_; + @__ = @res; + my $str; + if ($iseval) { + $__ = "@res"; + } elsif ($fancy) { + local $Data::Dumper::Deparse = 1; + local $Data::Dumper::Indent = 0; + $__ = Data::Dumper::Dumper(@res > 1 ? \@res : $res[0]); + $__ =~ s/^\$VAR1 = //; + $__ =~ s/;$//; } else { - print "=> @res\n"; + $__ = "@res"; + } + if ($iseval) { + print ';;;', length $__, "\n$__\n"; + } else { + print "=> $__\n"; } } =item C -Execute a command prompt on FH. +Execute a command interpreter on FH. The prompt has a few bells and +whistles, including: + + * Obviously-incomplete lines are treated as multiline input. + + * C is overridden to enter a recursive interpreter at the point + C is called. From within this interpreter, you can examine a + backtrace by calling "bt", return from C 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<$PS1> -- the default prompt + +=item C<$stopdie> -- true to enter the inspector on C + +=item C<$stopwarn> -- true to enter the inspector on C + +=item C<$fancy> -- true for pretty-printing via L + +=item C<%REPL> -- maps shortcut names to handlers =cut +use vars qw($PS1 $ps1 $dies $stopdie $stopwarn $fancy %REPL $PACKAGE); +BEGIN { + no strict; + $ps1 = $PS1 = "> "; + $dies = 0; + $stopdie = 1; + $stopwarn = 0; + $fancy = 1; + $PACKAGE = 'main'; + *REALDIE = *CORE::GLOBAL::die; + *REALWARN = *CORE::GLOBAL::warn; + %REPL = (h => \&Sepia::repl_help, + cd => \&Sepia::repl_chdir); +} + +sub Dump { + Data::Dumper->Dump([$_[0]], [$_[1]]); +} + +my $FRAMES = 4; + +sub hiding_me +{ + my ($fn, @args) = @_; + sub { + uplevel $FRAMES, $fn, @args + } +} + +sub eval_in_env +{ + my ($expr, $env) = @_; + local $::ENV = $env; + my $str = ''; + for (keys %$env) { + next unless /^([\$\@%])(.+)/; + $str .= "local *$2 = \$::ENV->{'$_'}; "; + } + eval "do { no strict; $str $expr }"; +} + +sub debug_upeval +{ + my ($lev, $exp) = $_[0] =~ /^\s*(\d+)\s+(.*)/; + print " <= $exp\n"; + (0, eval_in_env($exp, PadWalker::peek_my(0+$lev))); +} + +sub debug_inspect +{ + local $_ = shift; + for my $i (split) { + my $sub = (caller $i)[3]; + next unless $sub; + my $h = PadWalker::peek_my($i); + print "[$i] $sub:\n"; + for (sort keys %$h) { + print "\t", Sepia::Dump($h->{$_}, $_); + } + } + 0; +} + +sub repl_help +{ + print <>/tmp/blah"; +# print O "##############################\n$buf"; +# close O; + if ($wantarray || !defined($wantarray)) { + eval $buf; + } else { + scalar eval $buf; + } +} + sub repl { - my $fh = shift; + my ($fh, $level) = @_; + select((select($fh), $|=1)[0]); + my $in; my $buf = ''; - my $ps1 = "> "; + + my $nextrepl = sub { $buf = ""; next repl }; + + local *__; + my $MSG = "('\\C-c' to exit, ',h' for help)"; + my %dhooks = ( + b => \&Sepia::debug_backtrace, + i => \&Sepia::debug_inspect, + e => \&Sepia::debug_upeval, + r => \&Sepia::debug_return, + h => \&Sepia::debug_help, + ); + local *CORE::GLOBAL::die = sub { + my @dieargs = @_; + if ($stopdie) { + local $dies = $dies+1; + local $ps1 = "*$dies*$PS1"; + no strict; + local %Sepia::REPL = ( + %dhooks, d => sub { local $Sepia::stopdie=0; die @dieargs }); + print "@_\nDied $MSG\n"; + return Sepia::repl($fh, 1); + } + CORE::die(@_); + }; + + local *CORE::GLOBAL::warn = sub { + if ($stopwarn) { + local $dies = $dies+1; + local $ps1 = "*$dies*$PS1"; + no strict; + local %Sepia::REPL = ( + %dhooks, w => sub { local $Sepia::stopwarn=0; warn @dieargs }); + print "@_\nWarned $MSG\n"; + return Sepia::repl($fh, 1); + } + CORE::warn(@_); + }; + print $ps1; - repl: while (my $in = <$fh>) { + my @sigs = qw(INT TERM PIPE ALRM); + local @SIG{@sigs}; + $SIG{$_} = $nextrepl for @sigs; + repl: while (my $in = <$fh>) { $buf .= $in; - my $marker; - if ($buf =~ /^eval\s+<<(REPL\S*)\s*$/) { - $marker = $1; - $buf = ''; - local $/ = "\n$1\n"; - chomp($buf = <$fh>); + my $iseval; + if ($buf =~ /^<<(\d+)\n(.*)/) { + $iseval = 1; + my $len = $1; + my $tmp; + $buf = $2; + while ($len && defined($tmp = read $fh, $buf, $len, length $buf)) { + $len -= $tmp; + } } - local $SIG{INT} = sub { $buf = ""; next repl }; - my @warn; + my (@res, @warn); local $SIG{__WARN__} = sub { push @warn, shift; }; - my @res; - { - no strict; - @res = eval $buf; - } - if ($@) { - if ($@ =~ /at EOF$/m) { - if ($in eq "\n") { - print "*** cancel ***\n$ps1"; - $buf = ''; - } else { - print ">> "; + if ($buf =~ /^,(\S+)\s*(.*)/s) { + ## Inspector shortcuts + if (exists $Sepia::REPL{$1}) { + my $ret; + ($ret, @res) = $Sepia::REPL{$1}->($2, wantarray); + if ($ret) { + return wantarray ? @res : $res[0]; } - next repl; } else { - warn $@; + print "Unrecignized shortcut '$1'\n"; $buf = ''; - Sepia::printer \@res, $marker if $marker; + print $ps1; + next repl; } } else { - Sepia::printer \@res, $marker unless $buf =~ /;$/; - $buf = ''; + ## Ordinary eval + @res = repl_eval $buf, wantarray; + + if ($@) { + if ($@ =~ /at EOF$/m) { + ## Possibly-incomplete line + if ($in eq "\n") { + print "*** cancel ***\n$ps1"; + $buf = ''; + } else { + print ">> "; + } + next repl; + } else { + warn $@; + $buf = ''; + Sepia::printer \@res, $iseval, wantarray if $iseval; + } + } + } + if ($buf !~ /;$/) { + ## Be quiet if it ends with a semicolon. + Sepia::printer \@res, $iseval, wantarray; + } + $buf = ''; + if (@warn) { + if ($iseval) { + my $tmp = "@warn"; + print ';;;'.length($tmp)."\n$tmp\n"; + } else { + print "@warn\n"; + } } - print "@warn\n" if @warn; print $ps1; } } sub perl_eval { - tolisp(eval shift); + tolisp(repl_eval(shift)); } 1; diff --git a/sepia.el b/sepia.el index 4707add..21faf53 100644 --- a/sepia.el +++ b/sepia.el @@ -20,33 +20,61 @@ (defvar perl-process nil) (defvar perl-output nil) +(defvar perl-passive-output "") (defun perl-collect-output (string) (setq perl-output (concat perl-output string)) "") (defun perl-eval-raw (str) - (let ((perl-output "") - (comint-preoutput-filter-functions '(perl-collect-output))) - (comint-send-string perl-process - (concat "eval < $" perl-output))) - (accept-process-output perl-process)) - (and (string-match "\nREPLEND\n\\(.*\\)\nREPLEND\n" perl-output) - (match-string 1 perl-output)))) - -(defun perl-eval (str &optional context) - (let ((res - (perl-eval-raw - (case context - (list-context - (concat "tolisp([" str "])")) - (scalar-context - (concat "tolisp(scalar(" str "))")) - (t (concat str ";1")))))) - (when res - (car (read-from-string res))))) + (let (ocpof) + (unwind-protect + (let ((perl-output "") +;; (comint-preoutput-filter-functions '(perl-collect-output)) + (start 0)) + (with-current-buffer (process-buffer perl-process) + (setq ocpof comint-preoutput-filter-functions + comint-preoutput-filter-functions '(perl-collect-output))) + (setq str (concat "local $Sepia::stopdie = 0;\n" + "local $Sepia::stopwarn = 0;\n" + str "\n")) + (comint-send-string perl-process + (concat (format "<<%d\n" (length str)) str)) + (while (not (and perl-output + (string-match "> $" perl-output))) + (accept-process-output perl-process)) + (if (string-match "^;;;[0-9]+\n" perl-output) + (cons + (let* ((x (read-from-string perl-output (+ start 3))) + (len (car x)) + (pos (cdr x))) + (prog1 (substring perl-output (1+ pos) (+ len pos 1)) + (setq start (+ pos len 1)))) + (and (string-match ";;;[0-9]+\n" perl-output start) + (let* ((x (read-from-string + perl-output + (+ (match-beginning 0) 3))) + (len (car x)) + (pos (cdr x))) + (substring perl-output (1+ pos) (+ len pos 1))))) + (cons perl-output nil))) + (with-current-buffer (process-buffer perl-process) + (setq comint-preoutput-filter-functions ocpof))))) + +(defun perl-eval (str &optional context detailed) + (let* ((tmp (perl-eval-raw + (case context + (list-context + (concat "Sepia::tolisp([" str "])")) + (scalar-context + (concat "Sepia::tolisp(scalar(" str "))")) + (t (concat str ";1"))))) + (res (car tmp)) + (errs (cdr tmp))) + (setq res (if context (car (read-from-string res)) 1)) + (if detailed + (cons res errs) + res))) (defun perl-call (fn context &rest args) (perl-eval (concat fn "(" (mapconcat #'to-perl args ", ") ")") context)) @@ -112,10 +140,35 @@ might want to bind your keys, which works best when bound to (concat mod "::" sym) sym)) +(defun sepia-watch-for-eval (string) + (setq perl-passive-output (concat perl-passive-output string)) + (cond + ((string-match "^;;;###[0-9]+" perl-passive-output) + (when (string-match "^;;;###\\([0-9]+\\)\n\\(?:.\\|\n\\)*> " + perl-passive-output) + (let* ((len (car (read-from-string + (match-string 1 perl-passive-output)))) + (pos (1+ (match-end 1))) + (res (ignore-errors (eval (car (read-from-string + perl-passive-output pos + (+ pos len))))))) + (insert (format "%s => %s\n> " + (substring perl-passive-output pos (+ pos len)) res)) + (goto-char (point-max)) + (comint-set-process-mark) + (message "%s => %s" (substring perl-passive-output pos (+ pos len)) + res) + (setq perl-passive-output ""))) + "") + (t (setq perl-passive-output "") string))) + (defun sepia-comint-setup () (comint-mode) (set (make-local-variable 'comint-dynamic-complete-functions) '(sepia-complete-symbol comint-dynamic-complete-filename)) + (set (make-local-variable 'comint-preoutput-filter-functions) + '(sepia-watch-for-eval)) + (set (make-local-variable 'comint-use-prompt-regexp) t) (local-set-key (kbd "TAB") 'comint-dynamic-complete) (modify-syntax-entry ?: "_") (modify-syntax-entry ?> ".") @@ -524,27 +577,21 @@ buffer. (defun sepia-load-file (file &optional rebuild-p collect-warnings) "Reload a file. With REBUILD-P (or a prefix argument when called interactively), also rebuild the xref database." - (interactive (progn (save-buffer) - (list (buffer-file-name) - prefix-arg - ;; (format "*%s errors*" (buffer-file-name)) - nil - ))) - (message - "sepia: %s returned %s" - (abbreviate-file-name file) - (perl-eval -;; (if collect-warnings -;; (format "{ local $SIG{__WARN__} = Sepia::emacs_warner('%s'); do '%s' }" -;; collect-warnings file) - (format "do '%s' ? 1 : $@" file) - 'scalar-context)) - (when collect-warnings - (with-current-buffer (get-buffer-create collect-warnings) - (sepia-display-errors (point-min) (point-max)) - (if (> (buffer-size) 0) - (pop-to-buffer (current-buffer)) - (kill-buffer (current-buffer))))) + (interactive (list (expand-file-name (buffer-file-name)) + prefix-arg + (format "*%s errors*" (buffer-file-name)))) + (save-buffer) + (let* ((tmp (perl-eval (format "do '%s' ? 1 : $@" file) 'scalar-context t)) + (res (car tmp)) + (errs (cdr tmp))) + (message "sepia: %s returned %s" (abbreviate-file-name file) res) + (when (and collect-warnings + (> (length errs) 1)) + (with-current-buffer (get-buffer-create collect-warnings) + (delete-region (point-min) (point-max)) + (insert errs) + (sepia-display-errors (point-min) (point-max)) + (pop-to-buffer (current-buffer))))) (when rebuild-p (xref-rebuild))) @@ -707,6 +754,7 @@ be bound to TAB." (let ((pos (point))) (cperl-indent-command) (when (and (= pos (point)) + (not (bolp)) (eq last-command 'sepia-indent-or-complete)) (sepia-complete-symbol)))) @@ -736,10 +784,11 @@ evaluate the current line and display the result." ;; Miscellany (defun my-perl-frob-region (pre post beg end replace-p) - (let* ((exp (concat pre "\"" - (shell-quote-argument (buffer-substring beg end)) - "\"" post)) - (new-str (format "%s" (perl-eval exp 'scalar-context)))) + (let* ((exp (concat pre "<<'SEPIA_END_REGION';\n" + (buffer-substring-no-properties beg end) + (if (= (char-before end) ?\n) "" "\n") + "SEPIA_END_REGION\n" post)) + (new-str (perl-eval exp 'scalar-context))) (if replace-p (progn (delete-region beg end) (goto-char beg) @@ -758,13 +807,16 @@ evaluate the current line and display the result." (beginning-of-line n) (point))) +;; asdf asdf asdf +;; asdf asdf asdf + (defun perl-pe-region (expr beg end &optional replace-p) "Do the equivalent of perl -pe on region (i.e. evaluate an expression on each line of region). With prefix arg, replace the region with the result." (interactive "MExpression: \nr\nP") (my-perl-frob-region - "{ my $ret='';my $region = " + "do { my $ret='';my $region = " (concat "; for (split /\n/, $region) { do { " expr ";}; $ret.=\"$_\\n\"}; $ret}") (my-bol-from beg) (my-eol-from end) replace-p)) @@ -775,16 +827,16 @@ expression on each line of region). With prefix arg, replace the region with the result." (interactive "MExpression:\nr\nP") (my-perl-frob-region - "{ my $ret='';my $region = " + "do { my $ret='';my $region = " (concat "; for (split /\n/, $region) { $ret .= do { " expr - ";} }; $ret}") + ";} }; ''.$ret}") (my-bol-from beg) (my-eol-from end) replace-p)) (defun perl-ize-region (expr beg end &optional replace-p) "Evaluate a Perl expression on the region as a whole. With prefix arg, replace the region with the result." (interactive "MExpression:\nr\nP") - (my-perl-frob-region "{ local $_ = " + (my-perl-frob-region "do { local $_ = " (concat "; do { " expr ";}; $_ }") beg end replace-p)) @@ -836,9 +888,9 @@ rebuild its Xrefs." (defun sepia-eval-no-run (string &optional discard collect-warnings) (condition-case err (sepia-eval - (concat "BEGIN { use B; B::minus_c(); $^C=1; } { " + (concat "\nBEGIN { use B; B::minus_c(); $^C=1; } { " string - "} BEGIN { die \"ok\\n\" }") + "}\nBEGIN { die \"ok\\n\" }") discard collect-warnings) (perl-error (if (string-match "^ok\n" (cadr err)) nil @@ -937,7 +989,7 @@ the only function that requires EPL (the rest can use Pmacs)." (goto-char (point-min)) (or (and (re-search-forward "^\\s *package\\s +\\([^ ;]+\\)" nil t) (match-string-no-properties 1)) - "main"))) + sepia-eval-package))) (defun sepia-doc-update () "Update documentation for a file. This documentation, taken from @@ -999,7 +1051,7 @@ the only function that requires EPL (the rest can use Pmacs)." (defun sepia-extract-next-warning (pos &optional end) (catch 'foo - (while (re-search-forward "^\\(.+\\) at \\(.+\\) line \\([0-9]+\\)\\.$" + (while (re-search-forward "^\\(.+\\) at \\(.+?\\) line \\([0-9]+\\)" end t) (unless (string= "(eval " (substring (match-string 2) 0 6)) (throw 'foo (list (match-string 2) @@ -1028,14 +1080,14 @@ interactively)." msgs))) (erase-buffer) (goto-char (point-min)) - (mapcar #'insert msgs) + (mapcar #'insert (nreverse msgs)) (goto-char (point-min)) (grep-mode))) (defun to-perl (thing) "Convert elisp data structure to Perl." (cond - ((null thing) "[]") + ((null thing) "undef") ((symbolp thing) (let ((pname (substitute ?_ ?- (symbol-name thing))) (type (string-to-char (symbol-name thing)))) -- 2.11.4.GIT