From 1e0ba4e0f81c1e15f91f93313af148374607b40c Mon Sep 17 00:00:00 2001 From: seano Date: Sun, 16 Sep 2007 00:48:57 +0000 Subject: [PATCH] version 0.92 + a bit --- ChangeLog | 75 ++++++++++- Makefile.PL | 9 +- README | 8 +- lib/Sepia.pm | 22 ++- lib/Sepia/Debug.pm | 73 +++++++--- lib/Sepia/Xref.pm | 15 ++- package.sh | 3 +- sepia-tree.el | 33 +++-- sepia.el | 388 ++++++++++++++++++++++++++++++----------------------- sepia.texi | 25 ++-- t/50expect.t | 24 ++-- 11 files changed, 429 insertions(+), 246 deletions(-) diff --git a/ChangeLog b/ChangeLog index 91904bb..71748c8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,66 @@ +2007-07-25 Sean O'Rourke + + * sepia.el (sepia-interactive-arg): use xref-completions rather + than xref-apropos for working completion. + +2007-07-25 Ye Wenbin + + * 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 + + * 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 + + * VERSION: 0.92 + * sepia.el (sepia-shared-map, etc.): fix keymap initialization. + +2007-06-06 Sean O'Rourke + + * lib/Sepia/Debug.pm: eval in lexical env when in debugger. + * t/50expect.t: REPL tests if you have Test::Expect. + * lib/Sepia/Debug.pm: use correct level when none given. + * lib/Sepia.pm: No longer bring in exporter (why did we?). + * sepia.el (sepia-init): always reinitialize sepia-mode-map. + * Makefile.PL: require 5.006 for warnings to quiet stupid "make + test". + 2007-06-05 Sean O'Rourke * Sepia.html: generate single-page manual instead of split. @@ -149,7 +212,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 @@ -346,7 +409,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. @@ -378,7 +441,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. @@ -395,10 +458,10 @@ 2004-04-04 Sean O'Rourke * 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 @@ -428,5 +491,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/Makefile.PL b/Makefile.PL index 570e785..aa2b0a4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,4 +1,5 @@ use ExtUtils::MakeMaker; +use 5.006; # for "no warnings" -- sorry! # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. @@ -9,11 +10,9 @@ WriteMakefile( 'B::Module::Info' => 0, 'Scalar::Util' => 0, }, - ($] >= 5.005 ? ## Add these new keywords supported since 5.005 - (AUTHOR => "Sean O'Rourke ", - ABSTRACT => 'Simple Emacs-Perl InterAction') - : ()), - LICENSE => 'perl' + AUTHOR => "Sean O'Rourke ", + ABSTRACT => 'Simple Emacs-Perl InterAction', + LICENSE => 'perl', ); print <. =cut -$VERSION = '0.90'; -@ISA = qw(Exporter); - -require Exporter; +$VERSION = '0.92'; use strict; use B; use Sepia::Debug; # THIS TURNS ON DEBUGGING INFORMATION! @@ -671,6 +668,7 @@ BEGIN { quit => \&Sepia::repl_quit, reload => \&Sepia::repl_reload, shell => \&Sepia::repl_shell, + eval => \&Sepia::repl_eval, ); %REPL_DOC = ( cd => @@ -718,8 +716,8 @@ sub repl_help { print "REPL commands (prefixed with ','):\n"; for (sort keys %REPL) { - print " ", - exists $REPL_DOC{$_} ? "$REPL_DOC{$_}\n": "$_ (undocumented)\n"; + print " ", exists $REPL_DOC{$_} ? "$REPL_DOC{$_}\n": + sprintf("%-18s (undocumented)\n", $_); } 0; } @@ -817,7 +815,7 @@ sub repl_methods $x =~ s/^\s+//; $x =~ s/\s+$//; if ($x =~ /^\$/) { - $x = repl_eval("ref $x"); + $x = $REPL{eval}->("ref $x"); return 0 if $@; } $re ||= '.?'; @@ -878,9 +876,9 @@ sub repl_shell sub repl_eval { - my ($buf, $wantarray, $pkg) = @_; + my ($buf) = @_; no strict; - local $PACKAGE = $pkg || $PACKAGE; + # local $PACKAGE = $pkg || $PACKAGE; if ($STRICT) { if (!$WANTARRAY) { $buf = 'scalar($buf)'; @@ -1006,7 +1004,7 @@ EOS } } else { ## Ordinary eval - @res = repl_eval $buf, wantarray; + @res = $REPL{eval}->($buf); if ($@) { if ($ISEVAL) { ## Always return results for an eval request @@ -1015,7 +1013,7 @@ EOS # print_warnings $ISEVAL; $buf = ''; print prompt; - } elsif ($@ =~ /at EOF$/m) { + } elsif ($@ =~ /(?:at|before) EOF$/m) { ## Possibly-incomplete line if ($in eq "\n") { print "Error:\n$@\n*** cancel ***\n", prompt; @@ -1046,7 +1044,7 @@ EOS sub perl_eval { - tolisp(repl_eval(shift)); + tolisp($REPL{eval}->(shift)); } =head2 C<$status = html_module_list($file [, $prefix])> diff --git a/lib/Sepia/Debug.pm b/lib/Sepia/Debug.pm index af3a8d2..fb67720 100644 --- a/lib/Sepia/Debug.pm +++ b/lib/Sepia/Debug.pm @@ -39,7 +39,7 @@ sub repl_backtrace # return value from die sub repl_return { - (1, Sepia::repl_eval(@_)); + (1, $Sepia::REPL{eval}->(@_)); } sub repl_lsbreak @@ -60,27 +60,63 @@ sub repl_lsbreak sub eval_in_env { my ($expr, $env) = @_; - local $::SEPIA_ENV = $env; + local $Sepia::ENV = $env; my $str = ''; for (keys %$env) { next unless /^([\$\@%])(.+)/; - $str .= "local *$2 = \$::SEPIA_ENV->{'$_'}; "; + $str .= "local *$2 = \$Sepia::ENV->{'$_'}; "; } eval "do { no strict; $str $expr }"; } -## XXX: this is a better approach (the local business above is vile), +sub tie_class +{ + my $sig = substr shift, 0, 1; + return $sig eq '$' ? 'Tie::StdScalar' + : $sig eq '@' ? 'Tie::StdArray' + : $sig eq '%' ? 'Tie::StdHash' + : die "Sorry, can't tie $sig\n"; +} + +# { +# require Tie::Array; +# require Tie::Hash; +# require Tie::Scalar; +# package Sepia::Array; +# our @ISA = qw(Tie::StdArray); +# sub TIEARRAY { bless $_[1], $_[0] } +# package Sepia::Hash; +# our @ISA = qw(Tie::StdHash); +# sub TIEHASH { bless $_[1], $_[0] } +# package Sepia::Scalar; +# our @ISA = qw(Tie::StdScalar); +# sub TIESCALAR { bless $_[1], $_[0] } +# } + +# sub eval_in_env3 +# { +# my ($expr, $env) = @_; +# my @vars = grep /^([\$\@%])(.+)/, keys %$env; +# my $body = 'sub { my ('.join(',', @vars).');'; +# for my $i (0..$#vars) { +# $body .= "tie $vars[$i], ".tie_class($vars[$i]).', $_['.$i.'];'; +# } +# $body .= "$expr }"; +# print STDERR "---\n$body\n---\n"; +# $body = eval $body; +# $@ || $body->(@{$env}{@vars}); +# } + +## XXX: this is a better approach (the local/tie business is vile), ## but it segfaults and I'm not sure why. sub eval_in_env2 { - my ($expr, $lev) = @_; - my $env = peek_my(2+$lev); - $lev += 4; - local $::SEPIA_ENV = $env; + my ($expr, $env, $fn) = @_; + local $Sepia::ENV = $env; my @vars = grep /^([\$\@%])(.+)/, keys %$env; my $body = 'sub { my ('.join(',', @vars).');'; for (@vars) { - $body .= "Devel::LexAlias::lexalias($lev, '$_', \\$_);" + $body .= "Devel::LexAlias::lexalias(\$Sepia::ENV, '$_', \\$_);" } $body .= "$expr }"; print STDERR "---\n$body\n---\n"; @@ -93,15 +129,21 @@ sub repl_upeval { my $exp = shift; # my ($lev, $exp) = $_[0] =~ /^\s*(\d+)\s+(.*)/; - print " <= $exp\n"; + # print " <= $exp\n"; # (0, eval_in_env2($exp, $level)); - (0, eval_in_env($exp, peek_my(0+$level))); + # (0, eval_in_env3($exp, peek_my(4 + $level))); + eval_in_env($exp, peek_my(4+$level)); } # inspect lexicals at level N, or current level sub repl_inspect { - my $i = shift || $level; + my $i = shift; + if ($i =~ /\d/) { + $i = 0+$i; + } else { + $i = $level + 3; + } my $sub = (caller $i)[3]; if ($sub) { my $h = peek_my($i+1); @@ -146,7 +188,7 @@ sub breakpoint my $h = breakpoint_file $file; if (defined $h) { $h->{$line} = $cond || 1; - return "$file\:$line $h->{$line}"; + return $cond ? "$file\:$line if $cond" : "$file\:$line"; } return undef; } @@ -156,7 +198,7 @@ sub repl_break my $arg = shift; $arg =~ s/^\s+//; $arg =~ s/\s+$//; - my ($f, $l, $cond) = $arg =~ /^(.+?):(\d+)\s*(.*)/, $arg; + my ($f, $l, $cond) = $arg =~ /^(.+?):(\d+)\s*(.*)/; $cond ||= 1; $f ||= $file; $l ||= $line; @@ -258,9 +300,10 @@ my %REPL = ( # }, backtrace => \&repl_backtrace, inspect => \&repl_inspect, - eval => \&repl_upeval, + # eval => \&repl_upeval, return => \&repl_return, lsbreak => \&repl_lsbreak, + eval => \&repl_upeval, # DANGER! ); my %REPL_DOC = ( diff --git a/lib/Sepia/Xref.pm b/lib/Sepia/Xref.pm index f8845ae..a154ba5 100644 --- a/lib/Sepia/Xref.pm +++ b/lib/Sepia/Xref.pm @@ -40,6 +40,8 @@ use Cwd 'abs_path'; use B qw(peekop class comppadlist main_start svref_2object walksymtable OPpLVAL_INTRO SVf_POK OPpOUR_INTRO OPf_MOD OPpDEREF_HV OPpDEREF_AV cstring); +# stupid warnings... +no warnings 'uninitialized'; =head2 Variables @@ -130,6 +132,7 @@ sub guess_module_file { return undef if $ofile =~ /Exporter\.pm$/; # Try for standard translation in %INC: (my $fn = $pack) =~ s/::/\//g; + return unless $fn; # stupid warnings... if (exists $INC{"$fn.pm"}) { return $INC{"$fn.pm"}; } @@ -201,7 +204,6 @@ sub process { my ($spack, $sname) = split_name($subname); $call{$name}{$pack}{$subname} = 1; - $callby{$sname}{$spack}{"$pack\::$name"} = 1; } elsif ($type eq 's' || $subname eq '(definitions)') { # definition @@ -672,10 +674,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 diff --git a/package.sh b/package.sh index 282f95e..5c06569 100755 --- a/package.sh +++ b/package.sh @@ -3,4 +3,5 @@ makeinfo --no-split --no-headers --html sepia.texi -o Sepia.html # cat MANIFEST.in > MANIFEST # ls doc/*.html >> MANIFEST -perl Makefile.PL && make && make test && make dist +# perl Makefile.PL && make && make test && make dist +perl Makefile.PL && make && make dist diff --git a/sepia-tree.el b/sepia-tree.el index 1d0acb4..137bef1 100644 --- a/sepia-tree.el +++ b/sepia-tree.el @@ -10,12 +10,16 @@ ;;; Code: + (require 'tree-widget nil t) +(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 +71,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 +84,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.el b/sepia.el index 4002575..9502b63 100644 --- a/sepia.el +++ b/sepia.el @@ -98,43 +98,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 @@ -189,10 +188,35 @@ 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)))) + +(defvar sepia-metapoint-map + (let ((map (make-sparse-keymap))) + (when (featurep 'ido) + (define-key map "j" 'sepia-jump-to-symbol)) + (dolist (kv '(("c" . sepia-callers) + ("C" . sepia-callees) + ("a" . sepia-apropos) + ("A" . sepia-var-apropos) + ("v" . sepia-var-uses) + ("V" . sepia-var-defs) + ;; ("V" . sepia-var-assigns) + ("\M-." . sepia-dwim) + ;; ("\M-." . sepia-location) + ("l" . sepia-location) + ("f" . sepia-defs) + ("r" . sepia-rebuild) + ("m" . sepia-module-find) + ("n" . sepia-next) + ("t" . find-tag) + ("d" . sepia-perldoc-this))) + (define-key map (car kv) (cdr kv))) + map) + "Keymap for Sepia functions. This is just an example of how you +might want to bind your keys, which works best when bound to +`\\M-.'.") + +(defvar sepia-shared-map + (let ((map (make-sparse-keymap))) (define-key map sepia-prefix-key sepia-metapoint-map) (define-key map "\M-," 'sepia-next) (define-key map "\C-\M-x" 'sepia-eval-defun) @@ -201,7 +225,9 @@ each inferior Perl prompt." (define-key map "\C-c\C-r" 'sepia-repl) (define-key map "\C-c\C-s" 'sepia-scratch) (define-key map "\C-c!" 'sepia-set-cwd) - (define-key map (kbd "TAB") 'sepia-indent-or-complete))) + (define-key map (kbd "TAB") 'sepia-indent-or-complete) + map) + "Sepia bindings common to all modes.") ;;;###autoload (defun sepia-perldoc-this (name) @@ -270,11 +296,7 @@ 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 () (unless (sepia-live-p) (setq sepia-process (get-buffer-process @@ -291,12 +313,29 @@ For modules within packages, see `sepia-module-list'." (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 () + "Start the Sepia REPL." + (interactive) + (sepia-init) ;; set up keymaps, etc. + (sepia-ensure-process) (pop-to-buffer (get-buffer "*sepia-repl*"))) +(defvar sepia-repl-mode-map + (let ((map (copy-keymap sepia-shared-map))) + (set-keymap-parent map gud-mode-map) + (define-key map (kbd "") 'comint-dynamic-complete) + (define-key map "\C-a" 'comint-bol) + map) + +"Keymap for Sepia interactive mode.") + (define-derived-mode sepia-repl-mode gud-mode "Sepia REPL" - "Major mode for the Sepia REPL." + "Major mode for the Sepia REPL. + +\\{sepia-repl-mode-map}" (set (make-local-variable 'comint-dynamic-complete-functions) '(sepia-complete-symbol comint-dynamic-complete-filename)) (set (make-local-variable 'comint-preoutput-filter-functions) @@ -304,11 +343,6 @@ For modules within packages, see `sepia-module-list'." ;; (set (make-local-variable 'comint-use-prompt-regexp) t) (modify-syntax-entry ?: "_") (modify-syntax-entry ?> ".") - ;; (use-local-map (copy-keymap (current-local-map))) - (sepia-install-keys sepia-repl-mode-map) - (define-key sepia-repl-mode-map - (kbd "") 'comint-dynamic-complete) - (define-key sepia-repl-mode-map "\C-a" 'comint-bol) (set (make-local-variable 'comint-prompt-regexp) "^[^>\n]*> *") (set (make-local-variable 'gud-target-name) "sepia") (set (make-local-variable 'gud-marker-filter) 'sepia-gud-marker-filter) @@ -355,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." @@ -383,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)) @@ -416,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) @@ -498,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." @@ -684,7 +725,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 @@ -728,16 +768,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) @@ -745,21 +783,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)) @@ -772,31 +809,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 @@ -984,17 +1063,21 @@ This function is intended to be bound to TAB." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; scratchpad code -;; (defvar sepia-mode-map nil "Keymap for Sepia mode.") +(defvar sepia-mode-map + (let ((map (copy-keymap sepia-shared-map))) + (set-keymap-parent map cperl-mode-map) + (define-key map "\C-c\C-h" nil) + map) + "Keymap for Sepia mode.") -(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-.'.") +(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) @@ -1005,53 +1088,19 @@ might want to bind your keys, which works best when bound to (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. + ;; Create glue wrappers for Module::Info funcs. + (unless (fboundp 'xref-completions) (dolist (x '((name "Find module name.\n\nDoes not require loading.") (version "Find module version.\n\nDoes not require loading.") (inc-dir "Find directory in which this module was found.\n\nDoes not require loading.") (file "Absolute path of file defining this module.\n\nDoes not require loading.") (is-core "Guess whether or not a module is part of the core distribution. Does not require loading.") - (modules-used "List modules used by this module.\n\nRequires loading.") - (packages-inside "List sub-packages in this module.\n\nRequires loading.") - (superclasses "List module's superclasses.\n\nRequires loading."))) + (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.") (method-completions "Complete on an object's methods.") @@ -1082,14 +1131,19 @@ Does not require loading.") (guess-module-file "Guess file corresponding to module.") (file-modules "List the modules defined in a file."))) (apply #'define-xref-function "Sepia::Xref" x)) - ;; Initialize built hash (sepia-init-perl-builtins))) +(defvar sepia-scratchpad-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map sepia-mode-map) + (define-key map "\C-j" 'sepia-scratch-send-line) + map)) + ;;;###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)) + (sepia-init)) ;;;###autoload (defun sepia-scratch () @@ -1256,7 +1310,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) @@ -1287,7 +1341,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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1462,7 +1516,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 976e016..c174cf3 100644 --- a/sepia.texi +++ b/sepia.texi @@ -474,13 +474,9 @@ supplied, stop only if it evaluates to true. @itemx up @var{n} Move the current stack frame up or down by @var{n} (or one) frames. -@item eval @var{n} @var{expr} -Evaluate @var{expr} in the lexical environment of frame @var{n} -(requires PadWalker). @var{expr} should not transfer control out of -this environment, but is free to modify its lexicals. - -@item inspect @var{n} -Inspect lexicals in frame @var{n}, counting upward from 1. +@item inspect [@var{n}] +Inspect lexicals in the current frame or frame @var{n}, counting upward +from 1. @item lsbreak List breakpoints. @@ -695,11 +691,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/50expect.t b/t/50expect.t index dd26bd1..91955e2 100644 --- a/t/50expect.t +++ b/t/50expect.t @@ -3,13 +3,13 @@ BEGIN { eval 'use Test::Expect'; if ($@) { - print STDERR "All skipped -- requires Test::Expect.\n$@\n"; - print "0..0\n"; + print "# requires Test::Expect\n1..1\nok 1\n"; exit 0; + } else { + eval 'use Test::Simple tests => 34'; } } -use Test::Simple tests => 32; use FindBin '$Bin'; use Sepia; use Sepia::Xref; @@ -18,7 +18,7 @@ expect_run command => "$^X -Mblib -MSepia -MSepia::Xref -e 'Sepia::repl(\\*STDIN, \\*STDOUT)'", prompt => [-re => 'main @[^>]*> '], quit => ',quit'; -expect_handle()->log_file('/tmp/b'); +expect_handle()->log_file('/tmp/b') if $ENV{USER} eq 'seano'; expect ",help", q!REPL commands (prefixed with ','): @@ -41,7 +41,8 @@ q!REPL commands (prefixed with ','): strict [0|1] Turn 'use strict' mode on or off wantarray [0|1] Set or toggle evaluation context who PACKAGE [RE] List variables and subs in PACKAGE matching optional - pattern RE.!; + pattern RE.! + if 0; expect ",wh Sepia::Xref xref", 'xref xref_definitions xref_main @@ -61,12 +62,17 @@ expect_send ',debug 1'; expect_send "do '$Bin/testy.pl';", 'get testy'; expect 'fib1 10', '=> 55', 'plain fib'; -expect ',br testy.pl:6', "break testy.pl:6 1", 'break?'; +expect ',br testy.pl:6', "break testy.pl:6 if 1", 'break?'; expect_send 'fib1 10'; expect_like qr|_<$Bin/testy.pl:6>|, 'break in fib'; +# XXX AGAIN STUPID EXPECT! +expect '$n = 3', "\$n = 3\n=> 3", 'munge lexicals'; +expect ',in', +'[3] DB::DB: + $n = \3', 'munged'; expect ',del', ''; -expect ',con', '=> 55', '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'; -expect_like qr/error: asdf/; +expect_send ',q', 'quit'; +expect_like qr/error: asdf/, 'saw die message'; -- 2.11.4.GIT