From 4f25431c159d97fb9620852eb33c5f9a907dfb03 Mon Sep 17 00:00:00 2001 From: seano Date: Thu, 31 May 2007 22:06:14 +0000 Subject: [PATCH] version 0.76_01 --- ChangeLog | 46 +++- README | 5 +- lib/Sepia.pm | 215 +++++++++++++---- lib/Sepia/Xref.pm | 7 +- package.sh | 10 +- sepia-ido.el | 2 +- sepia-tree.el | 2 +- sepia-w3m.el | 10 +- sepia.el | 695 +++++++++++++++++++++++++++++++++--------------------- sepia.texi | 175 ++++++++++---- test.pl | 23 +- 11 files changed, 785 insertions(+), 405 deletions(-) diff --git a/ChangeLog b/ChangeLog index 755ab12..f1dbd82 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,12 +1,49 @@ +2007-05-30 Sean O'Rourke + * sepia.texi: shiny new manual. + * lib/Sepia.pm (completions): add special 'VARIABLE' type. + (methods): add second $qualified arg. + (repl_reload): new function. + (sig_warn,repl): override __WARN__ (and __DIE__) cautiously. + (repl): nicer warning format. + + * sepia.el (sepia-eval-raw): stopwarn -> STOPWARN. + (sepia-load-file): Fix pop-up error buffer. + (sepia-lisp-to-perl): fix quoting of strings. + Good citizenship: + (sepia-mode): make a real major mode. + (sepia-scratchpad-mode): ditto. + +2007-05-29 Sean O'Rourke + + * lib/sepia/Xref.pm (pp_method_named): warn -> dprint. + * sepia.el (sepia-simple-method-before-point): new function. + (sepia-complete-symbol): use it to complete methods. + make w3m optional: + (sepia-perldoc-function,sepia-view-pod-function, + sepia-module-list-function): new variables. + (sepia-perldoc-this,sepia-view-pod): new functions. + * lib/Sepia.pm (repl): trim leading spaces. + (tolisp): escape metacharacters. + (repl): don't override "die" if someone has installed a + $SIG{__DIE__} handler + 2007-05-28 Sean O'Rourke - * VERSION: 0.75 + * VERSION: 0.75+ * sepia.el (sepia-core-version): new function. (sepia-indent-or-complete): fix abbrev expansion. + (sepia-symbol-info): report core version in eldoc. + (sepia-ident-before-point): new function. + (sepia-complete-symbol): use it instead of *-at-point. + (sepia-complete-symbol): complete arrays and hashes when '$' + starts a word. * lib/Sepia.pm (printer): Use @::__; distinguish "last as scalar" $__ from printed representation. ($PRINT_PRETTY): columnate lists if this is on. (columnate): fixed. + (repl_methods): add regex argument. + (repl_who): fix. + (completions): Add in package names. 2007-05-27 Sean O'Rourke @@ -18,10 +55,10 @@ * sepia.el (sepia-doc-scan-buffer): Better doc regex for variables. (sepia-indent-or-complete): try to expand abbrevs before - completion (try with snippet.el). + completion (try with snippet.el). (sepia-indent-expand-abbrev): control the above feature. (sepia-complete-symbol): scroll completion buffer; suggested by - Hilko Bengen. + Hilko Bengen. * lib/Sepia.pm (html_package_list,html_module_list): new functions. (completions): '$'-completion only generates scalars. @@ -29,7 +66,8 @@ documentation. (sepia-module-list,sepia-package-list): better output. (sepia-package-list,sepia-module-list): move Perl code to - Sepia.pm, generate list in inferior perl instead of shelling out. + Sepia.pm, generate list in inferior perl instead of shelling + out. 2007-05-23 Sean O'Rourke diff --git a/README b/README index 84a9ed4..d23ad5f 100644 --- a/README +++ b/README @@ -191,10 +191,10 @@ Install Sepia bindings in the current local keymap. Find all subroutines in a package. ** Documentation browsing -*** (`sepia-w3m-perldoc-this') +*** (`sepia-perldoc-this') View perldoc for module at point. -*** (`sepia-w3m-view-pod') +*** (`sepia-view-pod') View POD for the current buffer. *** (`sepia-package-list') @@ -241,7 +241,6 @@ some operations, if you don't mind losing completion. ** (Medium) Support user-defined abbrevs in REPL ** (Easy) Clean up Perl side a bit more. ** (Hard) Use module, file, line to filter results (Emacs side) - * BUGS ** Function definition lines may occasionally all go completely wrong. Rebuilding the Xref database fixes this. diff --git a/lib/Sepia.pm b/lib/Sepia.pm index b0c3105..267cfcc 100644 --- a/lib/Sepia.pm +++ b/lib/Sepia.pm @@ -9,15 +9,17 @@ Sepia - Simple Emacs-Perl Interface From inside Emacs: M-x load-library RET sepia RET - M-x sepia-init RET + M-x sepia-repl RET -At the prompt in the C<*perl-interaction*> buffer: +At the prompt in the C<*sepia-repl*> buffer: main @> ,help +For more information, please see F. + =cut -$VERSION = '0.75'; +$VERSION = '0.76_01'; @ISA = qw(Exporter); require Exporter; @@ -54,6 +56,12 @@ BEGIN { 0; }; } + eval { require Module::CoreList }; + if ($@) { + *Sepia::core_version = sub { '???' }; + } else { + *Sepia::core_version = sub { Module::CoreList->first_release(@_) }; + } } =head1 DESCRIPTION @@ -61,7 +69,9 @@ BEGIN { Sepia is a set of features to make Emacs a better tool for Perl development. This package contains the Perl side of the implementation, including all user-serviceable parts (for the -cross-referencing facility see L). +cross-referencing facility see L). This document is +aimed as Sepia developers; for user documentation, see +L. Though not intended to be used independent of the Emacs interface, the Sepia module's functionality can be used through a rough procedural @@ -69,10 +79,21 @@ interface. =head2 C<@compls = completions($string [, $type])> -Find a list of completions for C<$string> with glob type $type. +Find a list of completions for C<$string> with glob type C<$type>, +which may be "SCALAR", "HASH", "ARRAY", "CODE", "IO", or the special +value "VARIABLE", which means either scalar, hash, or array. Completion operates on word subparts separated by [:_], so e.g. "S:m_w" completes to "Sepia::my_walksymtable". +=head2 C<@compls = method_completions($expr, $string [,$eval])> + +Complete among methods on the object returned by C<$expr>. The +C<$eval> argument, if present, is a function used to do the +evaluation; the default is C, but for example the Sepia REPL +uses C. B: Since it has to evaluate +C<$expr>, method completion can be extremely problematic. Use with +care. + =cut sub _apropos_re($) @@ -131,7 +152,13 @@ sub completions } _completions $str; } else { @ret = grep { - $type eq 'SCALAR' ? defined ${$_} : defined *{$_}{$type} + if ($type eq 'SCALAR') { + defined ${$_}; + } elsif ($type eq 'VARIABLE') { + defined ${$_} || defined *{$_}{HASH} || defined *{$_}{ARRAY}; + } else { + defined *{$_}{$type} + } } _completions $str; if (defined $infunc && defined *{$infunc}{CODE}) { my ($apre) = _apropos_re($str); @@ -166,13 +193,41 @@ sub completions } lexicals($infunc); } } + ## Complete packages so e.g. "new B:T" -> "new Blah::Thing" + ## instead of "new Blah::Thing::" + if (!$type) { + @ret = map { /(.*)::$/ ? ($1, $_) : $_ } @ret; + } ## XXX: Control characters, $", and $1, etc. confuse Emacs, so ## remove them. grep { - !looks_like_number $_ && !/^[^\w\d_]$/ && !/^_ 0 && !looks_like_number $_ && !/^[^\w\d_]$/ && !/^_("ref($expr)"); + } elsif ($eval->('defined(%{'.$expr.'::})')) { + $x = $expr; + } else { + return; + } + unless ($@) { + my $re = _apropos_re $fn; + print STDERR "$x / $re\n"; + return sort { $a cmp $b } map { s/.*:://; $_ } + grep { defined *{$_}{CODE} && /::$re/ } methods($x, 1); + } +} + =head2 C<@locs = location(@names)> Return a list of [file, line, name] triples, one for each function @@ -450,6 +505,9 @@ sub tolisp($) } elsif (looks_like_number $thing) { ''.(0+$thing); } else { + ## XXX Elisp and perl have slightly different + ## escaping conventions, so we do this crap instead. + $thing =~ s/["\\]/\\\1/g; qq{"$thing"}; } } elsif ($t eq 'GLOB') { @@ -530,15 +588,15 @@ sub printer $res = "@res"; } elsif (@res == 1 && (ref $res[0]) =~ /^PDL/) { $res = $res[0]; - } elsif (!$iseval && $PRINT_PRETTY && @res > 1 && grep !ref $_, @res) { - $res = columnate(@res); + } elsif (!$iseval && $PRINT_PRETTY && @res > 1 && !grep ref, @res) { + $res = columnate(sort @res); print $res; return; } else { $res = $PRINTER->(); } if ($iseval) { - print ';;;', length $res, "\n$::__\n"; + print ';;;', length $res, "\n$res\n"; } else { print "=> $res\n"; } @@ -575,7 +633,7 @@ Behavior is controlled in part through the following package-globals: =item C<$WANTARRAY> -- evaluation context -=item C<$PRINT_PRETTY> -- format some output nicely (default = 0) +=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. @@ -597,7 +655,7 @@ BEGIN { $PACKAGE = 'main'; $WANTARRAY = 1; $PRINTER = \&Sepia::print_dumper; - $PRINT_PRETTY = 0; + $PRINT_PRETTY = 1; %REPL = (help => \&Sepia::repl_help, cd => \&Sepia::repl_chdir, methods => \&Sepia::repl_methods, @@ -607,18 +665,19 @@ BEGIN { format => \&Sepia::repl_format, strict => \&Sepia::repl_strict, quit => \&Sepia::repl_quit, + reload => \&Sepia::repl_reload, ); %REPL_DOC = ( cd => - 'cd DIR Change directory to DIR', + 'cd DIR Change directory to DIR', format => 'format [dumper|dump|yaml|plain] Set output formatter (default: dumper)', help => 'help Display this message', methods => < 'package PACKAGE Set evaluation package to PACKAGE', @@ -630,8 +689,10 @@ EOS 'wantarray [0|1] Set or toggle evaluation context', who => < + 'reload Reload Sepia.pm and relaunch the REPL.', ); %RK = abbrev keys %REPL; } @@ -768,10 +829,16 @@ sub repl_who sub methods { - my $pack = shift; + my ($pack, $qualified) = @_; no strict; - (grep(defined *{"$pack\::$_"}{CODE}, keys %{$pack.'::'}), - defined @{$pack.'::ISA'} ? (map methods($_), @{$pack.'::ISA'}) : ()); + my @own = $qualified ? grep { + defined *{$_}{CODE} + } map { "$pack\::$_" } keys %{$pack.'::'} + : grep { + defined *{"$pack\::$_"}{CODE} + } keys %{$pack.'::'}; + (@own, defined @{$pack.'::ISA'} + ? (map methods($_, $qualified), @{$pack.'::ISA'}) : ()); } sub repl_methods @@ -821,11 +888,22 @@ sub repl_quit 1; } +sub repl_reload +{ + do $INC{'Sepia.pm'}; + if ($@) { + print "Reload failed:\n$@\n"; + } else { + @_ = (select, 0); + goto &Sepia::repl; + } +} + sub debug_help { print < \&Sepia::debug_help, ); local *CORE::GLOBAL::die = sub { - my @dieargs = @_; - if ($STOPDIE) { + ## Protect us against people doing weird things. + if ($STOPDIE && !$SIG{__DIE__}) { + my @dieargs = @_; local $dies = $dies+1; local $PS1 = "*$dies*> "; no strict; local %Sepia::REPL = ( %dhooks, die => sub { local $Sepia::STOPDIE=0; die @dieargs }); local %Sepia::RK = abbrev keys %Sepia::REPL; - print "@_\nDied $MSG\n"; + print "@_\n\tin ".caller()."\nDied $MSG\n"; return Sepia::repl($fh, 1); } - CORE::die(@_); + CORE::die(Carp::shortmess @_); }; local *CORE::GLOBAL::warn = sub { - if ($STOPWARN) { + ## Again, this is above our pay grade: + if ($STOPWARN && $SIG{__WARN__} eq 'Sepia::sig_warn') { + my @dieargs = @_; local $dies = $dies+1; local $PS1 = "*$dies*> "; no strict; @@ -917,9 +1022,10 @@ sub repl print "@_\nWarned $MSG\n"; return Sepia::repl($fh, 1); } - CORE::warn(@_); + ## Avoid showing up in location information. + CORE::warn(Carp::shortmess @_); }; - print <> "; } - next repl; } else { - warn $@; + print_warnings; + # $@ =~ s/(.*) at eval .*/$1/; + print "error: $@\n"; + print prompt; $buf = ''; - Sepia::printer \@res, $iseval, wantarray if $iseval; } + next repl; } } if ($buf !~ /;$/ && $buf !~ /^,/) { @@ -999,14 +1117,7 @@ EOS Sepia::printer \@res, $iseval, wantarray; } $buf = ''; - if (@warn) { - if ($iseval) { - my $tmp = "@warn"; - print ';;;'.length($tmp)."\n$tmp\n"; - } else { - print "@warn\n"; - } - } + print_warnings $iseval; print prompt; } } @@ -1036,31 +1147,31 @@ sub html_module_list my $inst = inst(); return unless $inst; return unless open OUT, ">$file"; - print "

$_
- $_
  - $fs[0]}; + print OUT qq{
  - $fs[0]}; } else { - print qq{
  - $_
    - $_
      - $_}; + print OUT qq{
      - $_}; } - print '
      '; + print OUT '
    '; } } - print qq{
  } if @{$ns{$_}} > 1; + print OUT qq{
} if @{$ns{$_}} > 1; } - print "

\n"; close OUT; 1; } diff --git a/lib/Sepia/Xref.pm b/lib/Sepia/Xref.pm index c496649..7984eee 100644 --- a/lib/Sepia/Xref.pm +++ b/lib/Sepia/Xref.pm @@ -30,7 +30,7 @@ most of its code. =cut BEGIN { *_apropos_re = *Sepia::_apropos_re; } -$VERSION = '0.64'; +$VERSION = '0.65'; use strict; use Config; @@ -429,7 +429,7 @@ sub pp_method_named { $top = [$lastclass || "(method)", '->', $name]; undef $lastclass; } else { - warn "method_named: wtf: sizeof padval = ".@padval; + dprint 'method_named', "method_named: wtf: sizeof padval = ".@padval; } } @@ -605,7 +605,8 @@ sub _var_ret_list if ($mod) { @r = exists $h->{$mod} ? @{$h->{$mod}} : (); } else { - @r = map { @$_ } values %$h; + ## XXX: Need to revisit when this is/isn't an array! + @r = map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %$h; } @r = grep $_->{assign}, @r if $assign; @r = map { [@{$_}{qw(file line sub package)}] } @r; diff --git a/package.sh b/package.sh index 43414fe..b67d6fa 100755 --- a/package.sh +++ b/package.sh @@ -1,4 +1,6 @@ -files=$(perl -e 'chomp(@x=<>);print join ",",@x' MANIFEST) -ver=$(perl -Ilib -MSepia -e 'print $Sepia::VERSION') -cd .. -eval "tar czvf sepia-$ver.tgz sepia/{$files}" +#!/bin/sh + +makeinfo --html sepia.texi +cat MANIFEST.in > MANIFEST +ls sepia/*.html >> MANIFEST +perl Makefile.PL && make && make dist diff --git a/sepia-ido.el b/sepia-ido.el index 97c85a2..c8f657f 100644 --- a/sepia-ido.el +++ b/sepia-ido.el @@ -1,4 +1,4 @@ -(require 'ido) +(require 'ido nil t) (require 'cl) (defun* sepia-icompleting-recursive-read (prompt dir &key diff --git a/sepia-tree.el b/sepia-tree.el index 4c0a87b..1d0acb4 100644 --- a/sepia-tree.el +++ b/sepia-tree.el @@ -10,7 +10,7 @@ ;;; Code: -(require 'tree-widget) +(require 'tree-widget nil t) (defun sepia-tree-button-cb (widget &rest blah) (let* ((pw (widget-get widget :parent)) diff --git a/sepia-w3m.el b/sepia-w3m.el index fb26783..7fe615c 100644 --- a/sepia-w3m.el +++ b/sepia-w3m.el @@ -33,7 +33,7 @@ ;; http://emacs-w3m.namazu.org/ ;;; Code: -(require 'w3m-perldoc) +(require 'w3m-perldoc nil t) ;;;###autoload (defun w3m-about-perldoc-buffer (url &optional no-decode no-cache &rest args) @@ -67,17 +67,9 @@ ;;;###autoload (defun sepia-w3m-view-pod (&optional buffer) - "View POD for the current buffer." - (interactive) (w3m-goto-url (concat "about://perldoc-buffer/" (w3m-url-encode-string (buffer-name buffer))))) -;;;###autoload -(defun sepia-w3m-perldoc-this (mod) - "View perldoc for module at point." - (interactive (list (sepia-interactive-arg 'module))) - (w3m-perldoc mod)) - (defun sepia-module-list () "List installed modules with links to their documentation. diff --git a/sepia.el b/sepia.el index 18521b6..8abcb1b 100644 --- a/sepia.el +++ b/sepia.el @@ -28,6 +28,24 @@ (defvar sepia-program-name "perl" "* Perl program name.") +(defvar sepia-perldoc-function + (if (featurep 'w3m) 'w3m-perldoc 'cperl-perldoc) +"* Function to view modules' documentation. + +Useful values include `w3m-perldoc' and `cperl-perldoc'.") + +(defvar sepia-view-pod-function + (if (featurep 'w3m) 'sepia-w3m-view-pod 'sepia-perldoc-buffer) +"* Function to view modules' documentation. + +Useful values include `sepia-w3m-view-pod' and `sepia-perldoc-buffer'.") + +(defvar sepia-module-list-function + (if (featurep 'w3m) 'w3m-find-file 'browse-url-of-buffer) +"* Function to view a list of installed modules. + +Useful values include `w3m-find-file' and `browse-url-of-buffer'.") + (defvar sepia-process nil "The perl process with which we're interacting.") (defvar sepia-output nil @@ -54,8 +72,8 @@ look for \";;;###\" lisp evaluation markers.") (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;" + (setq str (concat "local $Sepia::STOPDIE=0;" + "local $Sepia::STOPWARN=0;" "{ package " (sepia-buffer-package) ";" str " }\n")) (comint-send-string sepia-process @@ -95,7 +113,9 @@ pair (RESULT . OUTPUT)." (t (concat str ";1"))))) (res (car tmp)) (errs (cdr tmp))) - (setq res (if context (car (read-from-string res)) 1)) + (setq res (if context + (if (string= res "") "" (car (read-from-string res))) + 1)) (if detailed (cons res errs) res))) @@ -133,6 +153,17 @@ each inferior Perl prompt." "") (t (setq sepia-passive-output "") string))) +(defun sepia-install-keys (&optional map) + "Install Sepia bindings in the current local keymap." + (interactive) + (let ((map (or map (current-local-map)))) + (define-key map sepia-prefix-key sepia-metapoint-map) + (define-key map "\M-," 'sepia-next) + (define-key map "\C-\M-x" 'sepia-eval-defun) + (define-key map "\C-c\C-l" 'sepia-load-file) + (define-key map "\C-c\C-d" 'sepia-view-pod) + (define-key map (kbd "TAB") 'sepia-indent-or-complete))) + (defun sepia-comint-setup () "Set up the inferior Perl process buffer." (comint-mode) @@ -167,46 +198,52 @@ subs from the evaluation package, it may not always work.") (defvar sepia-prefix-key "\M-." "* Prefix for functions in ``sepia-keymap''.") -(defvar sepia-keymap - (eval-when (load eval) - (let ((km (make-sparse-keymap))) - (dolist (kv '(("c" . sepia-callers) - ("C" . sepia-callees) - ("a" . sepia-apropos) - ("A" . sepia-var-apropos) - ("v" . sepia-var-uses) - ("V" . sepia-var-defs) - ;; ("V" . sepia-var-assigns) - ("\M-." . sepia-dwim) - ;; ("\M-." . sepia-location) - ("l" . sepia-location) - ("f" . sepia-defs) - ("r" . sepia-rebuild) - ("m" . sepia-module-find) - ("n" . sepia-next) - ("t" . find-tag))) - (define-key km (car kv) (cdr kv))) - (when (featurep 'sepia-w3m) - (define-key km "d" 'sepia-w3m-perldoc-this)) - (when (featurep 'sepia-ido) - (define-key km "j" 'sepia-jump-to-symbol)) - km)) - "Keymap for Sepia functions. This is just an example of how you -might want to bind your keys, which works best when bound to -`\\M-.'.") +;;;###autoload +(defun sepia-perldoc-this (name) + "View perldoc for module at point." + (interactive (list (sepia-interactive-arg 'module))) + (funcall sepia-perldoc-function name)) -(defun sepia-install-keys (&optional map) -"Install Sepia bindings in the current local keymap." +(defun sepia-view-pod () + "View POD for the current buffer." (interactive) - (let ((map (or map (current-local-map)))) - (define-key map sepia-prefix-key sepia-keymap) - (define-key map "\M-," 'sepia-next) - (define-key map "\C-\M-x" 'sepia-eval-defun) - (define-key map "\C-c\C-l" 'sepia-load-file) - (define-key map "\C-c\C-d" 'sepia-w3m-view-pod) - (define-key map (kbd "TAB") 'sepia-indent-or-complete))) + (funcall sepia-view-pod-function)) + +(defun sepia-module-list () + "List installed modules with links to their documentation. -(defun perl-name (sym &optional mod) +This lists not just top-level packages appearing in packlist +files, but all documented modules on the system, organized by +package." + (interactive) + (let ((file "/tmp/modlist.html")) + ;; (unless (file-exists-p file) + (sepia-eval-raw (format "Sepia::html_module_list(\"%s\")" file)) + (funcall sepia-module-list-function file))) + +(defun sepia-package-list () + "List installed packages with links to their documentation. + +This lists only top-level packages appearing in packlist files. +For modules within packages, see `sepia-module-list'." + (interactive) + (let ((file "/tmp/packlist.html")) + ;; (unless (file-exists-p file) + (sepia-eval-raw (format "Sepia::html_package_list(\"%s\")" file)) + (funcall sepia-module-list-function file))) + +(defun sepia-perldoc-buffer () + "View current buffer's POD using pod2html and `browse-url'." + (let ((buffer (get-buffer-create "*sepia-pod*")) + (errs (get-buffer-create "*sepia-pod-errors*")) + (inhibit-read-only t)) + (with-current-buffer buffer (erase-buffer)) + (save-window-excursion + (shell-command-on-region (point-min) (point-max) "pod2html" + buffer nil errs)) + (with-current-buffer buffer (browse-url-of-buffer)))) + +(defun sepia-perl-name (sym &optional mod) "Convert a Perl name to a Lisp name." (setq sym (substitute ?_ ?- (if (symbolp sym) (symbol-name sym) sym))) (if mod @@ -214,108 +251,24 @@ might want to bind your keys, which works best when bound to sym)) ;;;###autoload -(defun sepia-init (&optional noinit) -"Perform the initialization necessary to start Sepia. - -The following keys are bound to the prefix -``sepia-prefix-key'' (`\\M-.' by default), which can be changed -by setting ``sepia-prefix'' before calling ``sepia-init'': - -\\{sepia-keymap} -In addition to these keys, Sepia defines the following keys, -which may conflict with keys in your setup, but which are -intended to shadow similar functionality in elisp-mode: - -`\\C-c\\C-d' ``sepia-w3m-view-pod'' -`\\C-c\\C-l' ``sepia-load-file'' -`\\C-\\M-x' ``sepia-eval-defun'' -`\\M-,' ``sepia-next'' (shadows ``tags-loop-continue'') -" - (interactive "P") - (ignore-errors - (kill-process "perl") - (setq sepia-process nil)) - (unless noinit - ;; Load perl defs: +(defun sepia-repl () + "Start the Sepia REPL." + (interactive) + (sepia-init) ;; set up keymaps, etc. + (unless (and (processp sepia-process) + (eq (process-status sepia-process) 'run)) (setq sepia-process (get-buffer-process - (comint-exec (get-buffer-create "*perl-interaction*") + (comint-exec (get-buffer-create "*sepia-repl*") "perl" sepia-program-name nil - (append (and sepia-perl5lib - (mapcar - (lambda (x) (concat "-I" x)) - (split-string sepia-perl5lib ":"))) + (append (mapcar (lambda (x) (concat "-I" x)) + sepia-perl5lib) '("-MData::Dumper" "-MSepia" "-MSepia::Xref" "-e" "Sepia::repl(*STDIN)"))))) - (with-current-buffer "*perl-interaction*" + (with-current-buffer "*sepia-repl*" (sepia-comint-setup)) - (accept-process-output sepia-process 0 1) - - ;; Create glue wrappers for Module::Info funcs. - (dolist (x '((name "Find module name.\n\nDoes not require loading.") - (version "Find module version.\n\nDoes not require loading.") - (inc-dir -"Find directory in which this module was found.\n\nDoes not require loading.") - (file -"Absolute path of file defining this module.\n\nDoes not require loading.") - (is-core -"Guess whether or not a module is part of the core distribution. -Does not require loading.") - (modules-used -"List modules used by this module.\n\nRequires loading.") - (packages-inside -"List sub-packages in this module.\n\nRequires loading.") - (superclasses -"List module's superclasses.\n\nRequires loading."))) - (apply #'define-modinfo-function x)) - - ;; Create low-level wrappers for Sepia - (dolist (x '((completions "Find completions in the symbol table.") - (location "Find an identifier's location.") - (mod-subs "Find all subs defined in a package.") - (mod-decls "Generate declarations for subs in a package.") - (mod-file "Find the file defining a package.") - (apropos "Find subnames matching RE.") - (lexicals "Find lexicals for a sub.") - )) - (apply #'define-xref-function "Sepia" x)) - - (dolist (x '((rebuild "Build Xref database for current Perl process.") - (redefined "Rebuild Xref information for a given sub.") - - (callers "Find all callers of a function.") - (callees "Find all functions called by a function.") - - (var-apropos "Find varnames matching RE.") - (mod-apropos "Find modules matching RE.") - (file-apropos "Find files matching RE.") - - (var-defs "Find all definitions of a variable.") - (var-assigns "Find all assignments to a variable.") - (var-uses "Find all uses of a variable.") - - (mod-redefined "Rebuild Xref information for a given package.") - (guess-module-file "Guess file corresponding to module.") - (file-modules "List the modules defined in a file."))) - (apply #'define-xref-function "Sepia::Xref" x)) - - ;; Initialize built hash - (sepia-init-perl-builtins)) - (add-hook 'cperl-mode-hook 'sepia-install-eldoc) - (add-hook 'cperl-mode-hook 'sepia-doc-update) - (add-hook 'cperl-mode-hook 'sepia-cperl-mode-hook) - (when (boundp 'cperl-mode-map) - (sepia-install-keys cperl-mode-map)) - (when (boundp 'perl-mode-map) - (sepia-install-keys perl-mode-map)) - (unless noinit - (sepia-interact))) - -(defun sepia-cperl-mode-hook () - (set (make-local-variable 'beginning-of-defun-function) - 'sepia-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) - 'sepia-end-of-defun)) + (accept-process-output sepia-process 0 1)) + (pop-to-buffer (get-buffer "*sepia-repl*"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Xref @@ -323,7 +276,7 @@ Does not require loading.") (defun define-xref-function (package name doc) "Define a lisp mirror for a low-level Sepia function." (let ((lisp-name (intern (format "xref-%s" name))) - (pl-name (perl-name name package))) + (pl-name (sepia-perl-name name package))) (fmakunbound lisp-name) (eval `(defun ,lisp-name (&rest args) ,doc @@ -332,7 +285,7 @@ Does not require loading.") (defun define-modinfo-function (name &optional doc) "Define a lisp mirror for a function from Module::Info." (let ((name (intern (format "sepia-module-%s" name))) - (pl-func (perl-name name)) + (pl-func (sepia-perl-name name)) (full-doc (concat (or doc "") " This function uses Module::Info, so it does not require that the @@ -353,6 +306,8 @@ module in question be loaded."))) (defvar sepia-sub-re "^\\s *sub\\s +\$.+\\_>\$") +(defvar sepia-history nil) + (defun sepia-interactive-arg (&optional type) "Default argument for most Sepia functions. TYPE is a symbol -- either 'file to look for a file, or anything else to use the @@ -409,6 +364,8 @@ symbol at point." `(let ((it ,test)) (if it ,then ,@else))) +(defvar sepia-found-refiner) + (defun sepia-show-locations (locs) (when locs (pop-to-buffer (get-buffer-create "*sepia-places*")) @@ -429,8 +386,8 @@ symbol at point." (line-number-at-pos)) (setq line (line-number-at-pos)) (let ((tmpstr - (buffer-substring (my-bol-from (point)) - (my-eol-from (point))))) + (buffer-substring (sepia-bol-from (point)) + (sepia-eol-from (point))))) (if (> (length tmpstr) 60) (concat "\n " tmpstr) tmpstr))) @@ -558,7 +515,7 @@ to this location." (interactive "P") (multiple-value-bind (type obj) (sepia-ident-at-point) (sepia-set-found nil type) - (let* (module-doc-p + (let* ((module-doc-p nil) (ret (cond ((member type '(?% ?$ ?@)) (xref-var-defs obj)) @@ -566,9 +523,11 @@ to this location." (let (case-fold-search) (string-match "^[^A-Z]" obj))) (list (sepia-location obj))) - (t + ((sepia-looks-like-module obj) (setq module-doc-p t) - `((,(sepia-w3m-perldoc-this obj) 1 nil nil)))))) + `((,(sepia-perldoc-this obj) 1 nil nil))) + (t (setq module-doc-p t) + (call-interactively 'sepia-defs))))) (unless module-doc-p (if display-p (sepia-show-locations ret) @@ -650,7 +609,7 @@ If prefix argument given, move N functions forward." (setq where (point))) (let ((subname (sepia-defun-around-point where)) (mod (sepia-buffer-package))) - (xref-lexicals (perl-name subname mod)))) + (xref-lexicals (sepia-perl-name subname mod)))) ;;;###autoload (defun sepia-load-file (file &optional rebuild-p collect-warnings) @@ -662,7 +621,8 @@ also rebuild the xref database." prefix-arg (format "*%s errors*" (buffer-file-name)))) (save-buffer) - (let* ((tmp (sepia-eval (format "do '%s' ? 1 : $@" file) 'scalar-context t)) + (let* ((tmp (sepia-eval (format "do '%s' || ($@ && die $@)" file) + 'scalar-context t)) (res (car tmp)) (errs (cdr tmp))) (message "sepia: %s returned %s" (abbreviate-file-name file) res) @@ -679,8 +639,6 @@ also rebuild the xref database." (defvar sepia-found) (defvar sepia-found-head) -(defvar sepia-found-refiner) -(defvar sepia-history nil) (defun sepia-set-found (list &optional type) (setq list @@ -712,17 +670,17 @@ also rebuild the xref database." ;; Old version -- this may actually work better if ;; beginning-of-defun goes flaky on us. ;; (or (re-search-backward sub-re -;; (my-bol-from (point) -20) t) +;; (sepia-bol-from (point) -20) t) ;; (re-search-forward sub-re -;; (my-bol-from (point) 10) t)) +;; (sepia-bol-from (point) 10) t)) ;; (beginning-of-line) (variable (lambda (line ident) (let ((var-re (concat "\\_<" ident "\\_>"))) (cond (line (goto-line line) - (or (re-search-backward var-re (my-bol-from (point) -5) t) - (re-search-forward var-re (my-bol-from (point) 5) t))) + (or (re-search-backward var-re (sepia-bol-from (point) -5) t) + (re-search-forward var-re (sepia-bol-from (point) 5) t))) (t (goto-char (point-min)) (re-search-forward var-re nil t)))))) (t (lambda (line ident) (and line (goto-line line)))))) @@ -752,6 +710,60 @@ also rebuild the xref database." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Completion +(defun sepia-ident-before-point () + "Find the Perl identifier at or preceding point." + (save-excursion + (when (looking-at "[%$@*&]") + (forward-char 1)) + (let* ((end (point)) + (beg (progn + (when (re-search-backward "[^A-Za-z_0-9:]" nil 'mu) + (forward-char 1)) + (point))) + (sigil (if (= beg (point-min)) + nil + (char-before (point))))) + (list (when (member sigil '(?$ ?@ ?% ?* ?&)) sigil) + (buffer-substring-no-properties beg end))))) + +(defvar sepia-complete-methods t +"* Non-nil if Sepia should try to complete methods for \"$x->\". + +NOTE: this feature can be problematic, since it evaluates the +object in order to find its type. Currently completion is only +attempted for objects that are simple scalars.") + +(defun sepia-simple-method-before-point () + "Find the \"simple\" method call before point. + +Looks for a simple method called on a variable before point and +returns the list (OBJECT METHOD). For example, \"$x->blah\" +returns '(\"$x\" \"blah\"). Only simple methods are recognized, +because completing anything evaluates it, so completing complex +expressions would lead to disaster." + (when sepia-complete-methods + (let ((end (point)) + (bound (max (- (point) 100) (point-min))) + arrow beg) + (save-excursion + ;; XXX - can't do this because COMINT's syntax table is weird. + ;; (skip-syntax-backward "_w") + (skip-chars-backward "a-zA-Z0-9_") + (when (looking-back "->\\s *" bound) + (setq arrow (search-backward "->" bound)) + (skip-chars-backward "a-zA-Z0-9_:") + (cond + ;; $x->method + ((char-equal (char-before (point)) ?$) + (setq beg (1- (point)))) + ;; X::Class->method + ((sepia-looks-like-module (thing-at-point 'symbol)) + (setq beg (point)))) + (when beg + (list (buffer-substring-no-properties beg arrow) + (buffer-substring-no-properties (+ 2 arrow) end) + (buffer-substring-no-properties beg end)))))))) + (defun sepia-ident-at-point () "Find the Perl identifier at point." (save-excursion @@ -800,10 +812,15 @@ annoying in larger programs. The function is intended to be bound to \\M-TAB, like ``lisp-complete-symbol''." (interactive) - (let ((win (get-buffer-window "*Completions*" 0))) + (let ((win (get-buffer-window "*Completions*" 0)) + len + completions + type + meth) (if (and (eq last-command this-command) win (window-live-p win) (window-buffer win) (buffer-name (window-buffer win))) + ;; If this command was repeated, and ;; there's a fresh completion window with a live buffer, ;; and this command is repeated, scroll that window. @@ -814,43 +831,57 @@ The function is intended to be bound to \\M-TAB, like (select-window win) (scroll-up)))) - (multiple-value-bind (type name) (sepia-ident-at-point) - (let ((len (+ (if type 1 0) (length name))) - (completions (xref-completions - name - (case type - (?$ "SCALAR") - (?@ "ARRAY") - (?% "HASH") - (?& "CODE") - (?* "IO") - (t "")) - (and (not (eq major-mode 'comint-mode)) - (sepia-function-at-point))))) - (when (and (not completions) - (or (not type) (eq type ?&))) - (when (string-match ".*::([^:]+)$" name) - (setq name (match-string 1 name))) - (setq completions (all-completions name sepia-perl-builtins))) - (case (length completions) - (0 (message "No completions for %s." name) nil) - (1 ;; (delete-ident-at-point) - (delete-region (- (point) len) (point)) - (insert (if type (string type) "") (car completions)) - ;; Hide stale completions buffer (stolen from lisp.el). - (if win (with-selected-window win (bury-buffer))) - t) - (t (let ((old name) - (new (try-completion "" completions))) - (if (string= new old) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list completions)) - (let ((win (get-buffer-window "*Completions*" 0))) - (if win (with-selected-window win (bury-buffer)))) - (delete-region (- (point) len) (point)) - (insert (if type (string type) "") new))) - t))) - )))) + ;; Otherwise actually do completion: + ;; 1 - Look for a method call: + (setq meth (sepia-simple-method-before-point)) + (when meth + (setq len (length (caddr meth)) + completions (xref-method-completions + (cons 'expr (format "'%s'" (car meth))) + (cadr meth) + "Sepia::repl_eval") + type (format "%s->" (car meth)))) + (multiple-value-bind (typ name) (sepia-ident-before-point) + ;; 2 - look for a regular function/variable/whatever + (unless completions + (setq type typ + len (+ (if type 1 0) (length name)) + completions (xref-completions + name + (case type + (?$ "VARIABLE") + (?@ "ARRAY") + (?% "HASH") + (?& "CODE") + (?* "IO") + (t "")) + (unless (eq major-mode 'comint-mode) + (sepia-function-at-point))))) + ;; 3 - try a Perl built-in + (when (and (not completions) + (or (not type) (eq type ?&))) + (when (string-match ".*::([^:]+)$" name) + (setq name (match-string 1 name))) + (setq completions (all-completions name sepia-perl-builtins))) + (case (length completions) + (0 (message "No completions for %s." name) nil) + (1 ;; XXX - skip sigil to match s-i-before-point + (when (looking-at "[%$@*&]") + (forward-char 1)) + (delete-region (- (point) len) (point)) + (insert (or type "") (car completions)) + ;; Hide stale completions buffer (stolen from lisp.el). + (if win (with-selected-window win (bury-buffer))) t) + (t (let ((old name) + (new (try-completion "" completions))) + (if (<= (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))) (defvar sepia-indent-expand-abbrev t "* If non-NIL, `sepia-indent-or-complete' tries `expand-abbrev'.") @@ -876,101 +907,207 @@ This function is intended to be bound to TAB." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; scratchpad code +(defvar sepia-mode-map nil "Keymap for Sepia mode.") + +(defvar sepia-metapoint-map nil + "Keymap for Sepia functions. This is just an example of how you +might want to bind your keys, which works best when bound to +`\\M-.'.") + ;;;###autoload -(defun sepia-scratch () - "Create a buffer to interact with a Perl interpreter. +(define-derived-mode sepia-mode cperl-mode "Sepia" + "Major mode for Perl editing, derived from cperl mode. +\\{sepia-mode-map}" + (sepia-init) + (sepia-install-eldoc) + (sepia-doc-update) + (set (make-local-variable 'beginning-of-defun-function) + 'sepia-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + 'sepia-end-of-defun) + (sepia-init)) + +(defun sepia-init () + "Perform the initialization necessary to start Sepia." + (unless sepia-metapoint-map + ;; first time! + (setq sepia-metapoint-map (make-sparse-keymap)) + (dolist (kv '(("c" . sepia-callers) + ("C" . sepia-callees) + ("a" . sepia-apropos) + ("A" . sepia-var-apropos) + ("v" . sepia-var-uses) + ("V" . sepia-var-defs) + ;; ("V" . sepia-var-assigns) + ("\M-." . sepia-dwim) + ;; ("\M-." . sepia-location) + ("l" . sepia-location) + ("f" . sepia-defs) + ("r" . sepia-rebuild) + ("m" . sepia-module-find) + ("n" . sepia-next) + ("t" . find-tag) + ("d" . sepia-perldoc-this))) + (define-key sepia-metapoint-map (car kv) (cdr kv))) + (when (featurep 'ido) + (define-key sepia-metapoint-map "j" 'sepia-jump-to-symbol))) + (unless sepia-mode-map + (setq sepia-mode-map (make-sparse-keymap)) + ;; Undo annoying binding of C-h, which breaks key help. Move it + ;; elsewhere? + (define-key sepia-mode-map "\C-c\C-h" nil) + ;; (define-key sepia-mode-map "\C-chF" 'cperl-info-on-command) + ;; (define-key sepia-mode-map "\C-cha" 'cperl-toggle-autohelp) + ;; (define-key sepia-mode-map "\C-chf" 'cperl-info-on-current-command) + ;; (define-key sepia-mode-map "\C-chm" 'sepia-perldoc-this) + ;; (define-key sepia-mode-map "\C-chv" 'cperl-get-help) + + (sepia-install-keys sepia-mode-map) + ;; Load perl defs: + ;; Create glue wrappers for Module::Info funcs. + (dolist (x '((name "Find module name.\n\nDoes not require loading.") + (version "Find module version.\n\nDoes not require loading.") + (inc-dir "Find directory in which this module was found.\n\nDoes not require loading.") + (file "Absolute path of file defining this module.\n\nDoes not require loading.") + (is-core "Guess whether or not a module is part of the core distribution. +Does not require loading.") + (modules-used "List modules used by this module.\n\nRequires loading.") + (packages-inside "List sub-packages in this module.\n\nRequires loading.") + (superclasses "List module's superclasses.\n\nRequires loading."))) + (apply #'define-modinfo-function x)) + + ;; Create low-level wrappers for Sepia + (dolist (x '((completions "Find completions in the symbol table.") + (method-completions "Complete on an object's methods.") + (location "Find an identifier's location.") + (mod-subs "Find all subs defined in a package.") + (mod-decls "Generate declarations for subs in a package.") + (mod-file "Find the file defining a package.") + (apropos "Find subnames matching RE.") + (lexicals "Find lexicals for a sub.") + )) + (apply #'define-xref-function "Sepia" x)) + + (dolist (x '((rebuild "Build Xref database for current Perl process.") + (redefined "Rebuild Xref information for a given sub.") + + (callers "Find all callers of a function.") + (callees "Find all functions called by a function.") + + (var-apropos "Find varnames matching RE.") + (mod-apropos "Find modules matching RE.") + (file-apropos "Find files matching RE.") + + (var-defs "Find all definitions of a variable.") + (var-assigns "Find all assignments to a variable.") + (var-uses "Find all uses of a variable.") + + (mod-redefined "Rebuild Xref information for a given package.") + (guess-module-file "Guess file corresponding to module.") + (file-modules "List the modules defined in a file."))) + (apply #'define-xref-function "Sepia::Xref" x)) + + ;; Initialize built hash + (sepia-init-perl-builtins))) -The buffer is placed in cperl-mode; calling -``sepia-scratch-send-line'' will evaluate the current line and -display the result." +;;;###autoload +(define-derived-mode sepia-scratchpad-mode sepia-mode "Sepia-Scratch" + "Major mode for the Perl scratchpad, derived from Sepia mode." + (define-key sepia-scratchpad-mode-map "\C-j" 'sepia-scratch-send-line)) + +;;;###autoload +(defun sepia-scratch () + "Switch to the sepia scratchpad." (interactive) - (switch-to-buffer (get-buffer-create "*perl-scratch*")) - (cperl-mode) - (local-set-key "\C-j" 'sepia-scratch-send-line)) + (pop-to-buffer + (or (get-buffer "*sepia-scratch*") + (with-current-buffer (get-buffer-create "*sepia-scratch*") + (sepia-scratchpad-mode) + (current-buffer))))) (defun sepia-scratch-send-line (&optional scalarp) "Send the current line to perl, and display the result." (interactive "P") - (insert - (sepia-eval (concat "do{" - (buffer-substring (my-bol-from (point)) - (my-eol-from (point))) - "}") 'scalar-context))) + (insert "\n" + (format "%S" (sepia-eval-raw (concat "scalar do{" + (buffer-substring (sepia-bol-from (point)) + (sepia-eol-from (point))) + "}"))) + "\n")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Miscellany -(defun my-perl-frob-region (pre post beg end replace-p) +(defun sepia-perlize-region-internal (pre post beg end replace-p) "Pass buffer text from BEG to END through a Perl command." (let* ((exp (concat pre "<<'SEPIA_END_REGION';\n" (buffer-substring-no-properties beg end) (if (= (char-before end) ?\n) "" "\n") "SEPIA_END_REGION\n" post)) - (new-str (sepia-eval exp 'scalar-context))) + (new-str (sepia-eval-raw exp))) (if replace-p (progn (delete-region beg end) (goto-char beg) (insert new-str)) (message new-str)))) -(defun my-eol-from (pt &optional n) +(defun sepia-eol-from (pt &optional n) (save-excursion (goto-char pt) (end-of-line n) (point))) -(defun my-bol-from (pt &optional n) +(defun sepia-bol-from (pt &optional n) (save-excursion (goto-char pt) (beginning-of-line n) (point))) -;; asdf asdf asdf -;; asdf asdf asdf - -(defun perl-pe-region (expr beg end &optional replace-p) +(defun sepia-perl-pe-region (expr beg end &optional replace-p) "Do the equivalent of perl -pe on region \(i.e. evaluate an expression on each line of region). With prefix arg, replace the region with the result." (interactive "MExpression: \nr\nP") - (my-perl-frob-region + (sepia-perlize-region-internal "do { my $ret='';my $region = " (concat "; for (split /\n/, $region) { do { " expr ";}; $ret.=\"$_\\n\"}; $ret}") - (my-bol-from beg) (my-eol-from end) replace-p)) + (sepia-bol-from beg) (sepia-eol-from end) replace-p)) -(defun perl-ne-region (expr beg end &optional replace-p) +(defun sepia-perl-ne-region (expr beg end &optional replace-p) "Do the moral equivalent of perl -ne on region \(i.e. evaluate an expression on each line of region). With prefix arg, replace the region with the result." (interactive "MExpression:\nr\nP") - (my-perl-frob-region + (sepia-perlize-region-internal "do { my $ret='';my $region = " (concat "; for (split /\n/, $region) { $ret .= do { " expr ";} }; ''.$ret}") - (my-bol-from beg) (my-eol-from end) replace-p)) + (sepia-bol-from beg) (sepia-eol-from end) replace-p)) -(defun perl-ize-region (expr beg end &optional replace-p) +(defun sepia-perlize-region (expr beg end &optional replace-p) "Evaluate a Perl expression on the region as a whole. With prefix arg, replace the region with the result." (interactive "MExpression:\nr\nP") - (my-perl-frob-region "do { local $_ = " - (concat "; do { " expr ";}; $_ }") - beg end replace-p)) + (sepia-perlize-region-internal + "do { local $_ = " (concat "; do { " expr ";}; $_ }") beg end replace-p)) -(defun sepia-core-version (module) +(defun sepia-core-version (module &optional message) "Report the first version of Perl shipping with MODULE." (interactive (list (read-string "Module: " - nil nil (sepia-thing-at-point 'symbol)))) - (let ((res (sepia-eval - (format "eval { Module::CoreList->first_release('%s') }" module) - 'scalar-context))) - (if res - (message "%s was first released in %s." module res) - (message "%s is not in core." module)) + nil nil (sepia-thing-at-point 'symbol)) + t)) + (let* ((version + (sepia-eval + (format "eval { Sepia::core_version('%s') }" module) + 'scalar-context)) + (res (if version + (format "%s was first released in %s." module version) + (format "%s is not in core." module)))) + (when message (message "%s" res)) res)) (defun sepia-guess-package (sub &optional file) @@ -1008,6 +1145,14 @@ With prefix arg, replace the region with the result." (xref-redefined sub sepia-eval-package) (message "Defined %s" sub)))))) +;;;###autoload +(defun sepia-eval-expression (expr &optional list-p message-p) + "Evaluate EXPR in scalar context." + (interactive (list (read-string "Expression: ") current-prefix-arg t)) + (let ((res (sepia-eval expr (if list-p 'list-context 'scalar-context)))) + (when message-p (message "%s" res)) + res)) + (defun sepia-extract-def (file line obj mod) (with-current-buffer (find-file-noselect (expand-file-name file)) (save-excursion @@ -1017,17 +1162,14 @@ With prefix arg, replace the region with the result." (buffer-substring (point) (progn (end-of-defun) (point))))))) -(defun sepia-eval-no-run (string &optional discard collect-warnings) - (condition-case err - (sepia-eval - (concat "\nBEGIN { use B; B::minus_c(); $^C=1; } { " - string - "}\nBEGIN { die \"ok\\n\" }") - discard collect-warnings) - (perl-error (if (string-match "^ok\n" (cadr err)) - nil - (cadr err))) - (error err))) +(defun sepia-eval-no-run (string) + (let ((res (sepia-eval-raw + (concat "eval q#{ BEGIN { use B; B::minus_c(); $^C=1; } do { " + string + " };BEGIN { die \"ok\\n\" }#, $@")))) + (if (string-match "^ok\n" (car res)) + nil + (car res)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; REPL @@ -1037,13 +1179,8 @@ With prefix arg, replace the region with the result." (defvar sepia-eval-line nil "Line at which ``sepia-eval'' evaluates perl expressions.") -;;;###autoload -(defun sepia-interact () - "Start or switch to a perl interaction buffer." - (interactive) - (pop-to-buffer (get-buffer "*perl-interaction*"))) - (defun sepia-set-cwd (dir) + (interactive (list default-directory)) (sepia-call "Cwd::chdir" dir)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1109,42 +1246,53 @@ used for eldoc feedback." (puthash (second x) (third x) map) (puthash (concat pack (second x)) (third x) map))))) -(defun sepia-symbol-info () +(defun sepia-looks-like-module (obj) + (let (case-fold-search) + (or (string-match "^\$[A-Z].*::\$?[A-Z]+[a-z]+\\sw*$" obj) + (string-match + (eval-when-compile (regexp-opt '("strict" "vars" "warnings" "lib"))) + obj)))) + +(defun sepia-symbol-info (&optional obj type) "Eldoc function for Sepia-mode. Looks in ``sepia-doc-map'' and ``sepia-var-doc-map'', then tries calling ``cperl-describe-perl-symbol''." - (save-excursion - (multiple-value-bind (type obj) (sepia-ident-at-point) - (when (consp obj) - (setq obj (car obj))) - (unless type - (setq type 'function)) - (if (and obj (member type '(function variable module))) - (or (gethash obj (ecase (or type 'function) - (function sepia-doc-map) - (variable sepia-var-doc-map) - (module sepia-module-doc-map))) - ;; Loathe cperl a bit. - - (flet ((message (&rest blah) (apply #'format blah))) - (let* ((cperl-message-on-help-error nil) - (hlp (car (cperl-describe-perl-symbol obj)))) - (when hlp - ;; cperl's docstrings are too long. - (setq hlp (replace-regexp-in-string "\\s \\{2,\\}" " " hlp)) - (if (> (length hlp) 75) - (concat (substring hlp 0 72) "...") - hlp))))) - "")))) + (unless obj + (multiple-value-bind (ty ob) (sepia-ident-at-point) + (setq obj (if (consp ob) (car ob) ob) + type ty))) + (if obj + (or (gethash obj (ecase (or type ?&) + (?& sepia-doc-map) + ((?$ ?@ ?%) sepia-var-doc-map) + (nil sepia-module-doc-map))) + ;; Loathe cperl a bit. + (flet ((message (&rest blah) (apply #'format blah))) + (let* (case-fold-search + (cperl-message-on-help-error nil) + (hlp (car (cperl-describe-perl-symbol obj)))) + (if hlp + (progn + ;; cperl's docstrings are too long. + (setq hlp (replace-regexp-in-string "\\s \\{2,\\}" " " hlp)) + (if (> (length hlp) 75) + (concat (substring hlp 0 72) "...") + hlp)) + ;; Try to see if it's a module + (if (sepia-looks-like-module obj) + (sepia-core-version obj) + "")))) + ""))) (defun sepia-install-eldoc () "Install Sepia hooks for eldoc support." (interactive) + (require 'eldoc) (set-variable 'eldoc-documentation-function 'sepia-symbol-info t) (if cperl-lazy-installed (cperl-lazy-unstall)) (eldoc-mode 1) - (setq eldoc-idle-delay 1.0)) + (set-variable 'eldoc-idle-delay 1.0 t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Error jump: @@ -1161,7 +1309,7 @@ calling ``cperl-describe-perl-symbol''." (defun sepia-goto-error-at (pos) "Visit the source of the error on line at point." (interactive "d") - (ifa (sepia-extract-next-warning (my-bol-from pos) (my-eol-from pos)) + (ifa (sepia-extract-next-warning (sepia-bol-from pos) (sepia-eol-from pos)) (destructuring-bind (file line msg) it (find-file file) (goto-line line) @@ -1173,7 +1321,7 @@ calling ``cperl-describe-perl-symbol''." (interactive "r") (goto-char beg) (let ((msgs nil)) - (loop for w = (sepia-extract-next-warning (my-bol-from (point)) end) + (loop for w = (sepia-extract-next-warning (sepia-bol-from (point)) end) while w do (destructuring-bind (file line msg) w (push (format "%s:%d:%s\n" (abbreviate-file-name file) line msg) @@ -1194,9 +1342,12 @@ calling ``cperl-describe-perl-symbol''." (if (member type '(?% ?$ ?@ ?*)) pname (concat "\\*" pname)))) - ((stringp thing) (format "\"%s\"" thing)) + ((stringp thing) (format "\'%s\'" thing)) ((integerp thing) (format "%d" thing)) ((numberp thing) (format "%g" thing)) + ;; Perl expression + ((and (consp thing) (eq (car thing) 'expr)) + (cdr thing)) ; XXX -- need quoting?? ((and (consp thing) (not (consp (cdr thing)))) (concat (sepia-lisp-to-perl (car thing)) " => " (sepia-lisp-to-perl (cdr thing)))) diff --git a/sepia.texi b/sepia.texi index cd1c79e..ef4f764 100644 --- a/sepia.texi +++ b/sepia.texi @@ -80,7 +80,53 @@ Then to bring up the interactive Perl prompt, type @kbd{M-x sepia-repl}. @node Philosophy, , Getting Started, Introduction @section Philosophy -@xxx{There's a bit at the top of the README. Expand on it.} +A development environment should support three activities: code +spelunking, interaction, and customization. Emacs as an environment for +developing Emacs Lisp thoroughly supports all of them: It has commands +to visit individual functions' code and documentation, commands to +evaluate or step through expressions, and an architecture that +encourages customization in Emacs Lisp. As an environment for Perl, +however, it is lacking: there is limited interactivity with the Perl +debugger, and reasonable documentation browsing, but no support for +navigating, editing, and re-evaluating code. Sepia attempts to remedy +the situation. + +Modern IDEs also support these three activities, but do so awkwardly. +Rather than having functions to visit definitions (@kbd{find-function}) +and search for functions (@kbd{apropos}), they clutter the screen with +class and file trees. Rather than supporting interactive evaluation of +small pieces of code, they perform background semantic checking on whole +projects and highlight errors. Rather than allowing minor +customizations to grow organically into features, they support limited +configuration files and baroque plug-in APIs. Sepia tries to adhere to +the apparent Emacs philosophy that rich semantic information should be +unobtrusive, and that the best way to build working code is to start +by experimenting with small pieces. + +Language support packages for Emacs vary widely in the degree to which +they make use of or replace existing Emacs features. Minimal modes +provide keyword-based syntax highlighting and an unadorned comint buffer +as an interpreter. Others provide their own specialized equivalents of +comint, eldoc, completion, and other Emacs features. Sepia takes a +third approach by trying to do as much as possible with existing Emacs +features, even when they are not optimal for Perl. It uses comint to +communicate with the subprocess, eldoc to display documentation, and +grep to list source locations. + +This approach has three advantages: First, it maximizes the number of +features that can be supported with limited development time. Second, +it respects users' settings. A seasoned Emacs user may have changed +hundreds of settings, so a mode that reimplements features will have to +support equivalent settings, and will force the user to re-specify them. +Finally, this approach respects decades of development spent, as Neal +Stephenson put it, ``focused with maniacal intensity on the deceptively +simple-seeming problem of editing text.'' Many non-obvious choices go +into making a polished interface, and while a reimplementation gets rid +of accumulated cruft, it must rediscover these hidden trade-offs. + +Anyways, I hope you enjoy using Sepia. Its development style is strange +for someone used Perl's typical mix of one-liners and edit-save-run, but +once you are accustomed to it, you may find it very effective. @c ============================================================ @node Editing, Interactive Perl, Introduction, Top @@ -93,14 +139,63 @@ function and variable uses. Sepia also provides intelligent symbol completion. @menu +* Completion:: * Navigation:: * Documentation:: -* Evaluation:: -* Completion:: -* Mutilation:: @end menu -@node Navigation, Documentation, Editing, Editing +@node Completion, Navigation, Editing, Editing +@section Completion + +Sepia implements fairly sophisticated partial-word completion in +collaboration with the inferior Perl process. For example, +@samp{%S:X:v_u} completes to @samp{%Sepia::Xref::var_use} when Sepia is +loaded. This completion only operates on functions and global variables +known to the Perl interpreter, so it works best when code and +interpreter are in sync. + +More precisely, completion examines the text before point and tries each +of the following in turn, using the first successful approach: + +@enumerate +@item +If the text looks like a method call (e.g. @samp{$object->f} or +@samp{Class->f}), complete on methods. + +@item +If it looks like a variable, complete on variables; otherwise, complete +on modules and functions. + +@item +Otherwise, try to complete a Perl built-in operator. +@end enumerate + +For each of the first two, completions candidates are first generated by +splitting the text on characters @code{[:_]} and matching the resulting +word parts. For example, @samp{X:a_b} will complete to all symbols +matching @samp{^X[^:]*:a[^:_]*_b} such as @samp{Xref::a_bug} and +@samp{X::always_bites_me}. If no matches result, the text is treated as +an acronym. For example, @samp{dry} will complete to +@samp{dont_repeat_yourself}. + +@table @kbd +@item M-x sepia-complete-symbol +@findex sepia-complete-symbol +Complete the symbol before point as either a module, function, methd, or +global variable. Note that this does not consider lexical scope, and is +always case-sensitive, independent of @code{completion-ignore-case}. + +@item TAB +@itemx M-x sepia-indent-or-complete +@findex sepia-indent-or-complete +First try to indent the current line. If the indentation does not +change, then try to expand an abbrev at point (unless +@code{sepia-indent-expand-abbrev} is @code{NIL}). If no abbrev is +expanded, then call @code{sepia-complete-symbol}. + +@end table + +@node Navigation, Documentation, Completion, Editing @section Navigation Sepia provides several commands for navigating program source. All of @@ -166,27 +261,27 @@ Find definition(s) of function @var{name}. Find the source of module @var{name}. @item M-. a @var{regexp} @key{RET} -@itemx M-x sepia-apropos +@itemx M-x sepia-apropos @var{regexp} @key{RET} @findex sepia-apropos Find definitions of all functions whose names match @var{regexp}. @item M-. c @var{name} @key{RET} -@itemx M-x sepia-callers +@itemx M-x sepia-callers @var{name} @key{RET} @findex sepia-callers (Xref) Find calls to function @var{name}. @item M-. C @var{name} @key{RET} -@itemx M-x sepia-callees +@itemx M-x sepia-callees @var{name} @key{RET} @findex sepia-callees (Xref) Find the definitions of functions called by @var{name}. @item M-. v @var{name} @key{RET} -@itemx M-x sepia-var-uses +@itemx M-x sepia-var-uses @var{name} @key{RET} @findex sepia-var-uses (Xref) Find uses of the global variable @var{name}. @item M-. V @var{name} @key{RET} -@itemx M-x sepia-var-defs +@itemx M-x sepia-var-defs @var{name} @key{RET} @findex sepia-var-defs (Xref) Find definitions of global variable @var{name}. Since Perl's global variables are not declared, this is rarely useful @@ -223,7 +318,7 @@ Execute the @code{find-tag} command typically bound to @key{M-.}. @end table -@node Documentation, Evaluation, Navigation, Editing +@node Documentation, , Navigation, Editing @section Documentation Sepia can be used to browse installed modules' documentation, to format @@ -234,7 +329,7 @@ installed on the system. @item M-. d @var{name} @key{RET} @itemx M-x sepia-perldoc-this @findex sepia-perldoc-this -View documentation for module @var{name} or Perl manpage @var{name}. +View documentation for module @var{name} or Perl manual page @var{name}. @item C-c C-d @itemx M-x sepia-view-pod @@ -256,9 +351,9 @@ Browse a tree of both top-level and internal packages, like @end table @findex sepia-install-eldoc -Sepia also integrates with Eldoc (at least in GNU Emacs >= 22). To +Sepia also integrates with eldoc (at least in GNU Emacs >= 22). To toggle eldoc support, type @kbd{M-x sepia-install-eldoc}. Documentation -for Perl builtins and control structures is taken from CPerl mode. +for Perl operators and control structures is taken from CPerl mode. Sepia can also display documentation for user-defined functions if their POD is formatted in the standard way, with functions described in a ``=head2'' or ``=item'' entry. To load user documentation, visit the @@ -281,18 +376,20 @@ REPL, Sepia provides a number of other ways to evaluate pieces of code in Perl, and commands to process buffer regions with Perl. @findex sepia-repl -To start or switch to the repl, type @kbd{M-x sepia-repl}. As in Perl -code, @key{TAB} in the REPL performs partial-word completion with +To start or switch to the repl, type @kbd{M-x sepia-repl}. As +sepia-mode, @key{TAB} in the REPL performs partial-word completion with @code{sepia-complete-symbol}. However, it also supports filename completion like standard comint mode. @menu * Shortcuts:: -* The Debugger:: +* Debugger:: +* Evaluation:: +* Mutilation:: * Scratchpad:: @end menu -@node Shortcuts, The Debugger, Interactive Perl, Interactive Perl +@node Shortcuts, Debugger, Interactive Perl, Interactive Perl @section Shortcuts ``Shortcuts'' are commands handled specially by the REPL rather than @@ -342,7 +439,7 @@ optional pattern @var{regexp}. @end table -@node The Debugger, Scratchpad, Shortcuts, Interactive Perl +@node Debugger, Evaluation, Shortcuts, Interactive Perl @section Debugger Unfortunately Sepia does @emph{not} use Perl's debugger hooks, so it @@ -379,7 +476,7 @@ debugger intervention. @end table -@node Evaluation, Completion, Documentation, Editing +@node Evaluation, Mutilation, Debugger, Interactive Perl @section Evaluation When interactive Perl is running, Sepia can evaluate regions of code in @@ -405,35 +502,11 @@ the cross-reference index. Evaluate @var{expr} in scalar context and echo the result. With a prefix argument, evaluate in list context. -@end table - -@node Completion, Mutilation, Evaluation, Editing -@section Completion - -Sepia implements fairly sophisticated partial-word completion in -collaboration with the inferior Perl process. For example, -@samp{%S:X:v_u} completes to @samp{%Sepia::Xref::var_use} when Sepia is -loaded. - -@xxx{explain the rules for completion: packages, vars, subs, methods, ...} - -@table @kbd -@item M-x sepia-complete-symbol -@findex sepia-complete-symbol -Complete the symbol before point as either a module, function, or global -variable. Note that this does @emph{not} consider lexical scope. - -@item TAB -@itemx M-x sepia-indent-or-complete -@findex sepia-indent-or-complete -First try to indent the current line. If the indentation does not -change, then try to expand an abbrev at point (unless -@code{sepia-indent-expand-abbrev} is @code{NIL}). If no abbrev is -expanded, then call @code{sepia-complete-symbol}. +@item sepia-set-cwd @end table -@node Mutilation, , Completion, Editing +@node Mutilation, Scratchpad, Evaluation, Interactive Perl @section Mutilation Sepia contains several functions to operate on regions of text using the @@ -460,7 +533,7 @@ replace the region. @end table -@node Scratchpad, , The Debugger, Interactive Perl +@node Scratchpad, , Mutilation, Interactive Perl @section Scratchpad @findex sepia-scratch @@ -500,7 +573,7 @@ Default: @code{T}. @item sepia-eval-defun-include-decls If non-@code{NIL}, attempt to generate a declaration list for @code{sepia-eval-defun}. This is necessary when evaluating some code, -such as that calling functions without paretheses, because the presence +such as that calling functions without parentheses, because the presence of declarations affects the parsing of barewords. Default: @code{T}. @item sepia-indent-expand-abbrev @@ -584,8 +657,10 @@ If true, evaluate interactive expressions in list context. Default: true. @node Internals, Credits, Customization, Top @chapter Internals -@xxx{Many things remain unexplained except by the code itself, and some -details mentioned above should probably be given less prominence.} +Many things remain unexplained except by the code itself, and some +details mentioned above should probably be given less prominence. For +developer documentation, please see the POD for @code{Sepia} and +@code{Sepia::Xref}, and the doc-strings in @file{sepia.el}. @node Credits, Function Index, Internals, Top @unnumbered Credits diff --git a/test.pl b/test.pl index 60609d2..c11e049 100644 --- a/test.pl +++ b/test.pl @@ -42,11 +42,22 @@ ok(Sepia::module_info('Sepia', 'name') eq 'Sepia'); ok(Sepia::module_info('Sepia', 'version') eq $Sepia::VERSION); ok(Sepia::module_info('Sepia', 'file') =~ /Sepia\.pm$/); ok(Sepia::module_info('Sepia', 'is_core') == 0); -my @mu = sort(Sepia::module_info('Sepia', 'modules_used')); -my @mu_exp = qw(B Cwd Exporter Module::Info strict); -ok(1 || all(map { $mu[$_] eq $mu_exp[$_] } 0..$#mu), "@mu"); -ok((Sepia::module_info('Sepia', 'packages_inside'))[0] eq 'Sepia'); -ok((Sepia::module_info('Sepia', 'superclasses'))[0] eq 'Exporter'); -# 18 to here + +if (exists $INC{'Module/Info.pm'}) { + my %mu; + undef @mu{Sepia::module_info('Sepia', 'modules_used')}; + + my @mu_exp = ('B', 'Carp', 'Cwd', 'Exporter', 'Module::Info', + 'Scalar::Util', 'Text::Abbrev', 'strict', 'vars'); + + ok(all(map { exists $mu{$_} } @mu_exp), "uses (@mu_exp)"); + ok((Sepia::module_info('Sepia', 'packages_inside'))[0] eq 'Sepia'); + ok((Sepia::module_info('Sepia', 'superclasses'))[0] eq 'Exporter'); +} else { + ok(1, "no module info"); + ok(1, "no module info"); + ok(1, "no module info"); +} +# 18 to here. exit; -- 2.11.4.GIT