This is an automated email from the git hooks/post-receive script. bengen pushed a commit to branch master in repository sepia.
commit 30dd6a35f108622c89fb61d262ff546dfdacc9d3 Author: Hilko Bengen <ben...@debian.org> Date: Mon May 28 01:09:41 2007 +0200 Imported Debian patch 0.74-1 --- ChangeLog | 21 +++++++++ META.yml | 2 +- debian/changelog | 6 +++ lib/Sepia.pm | 130 ++++++++++++++++++++++++++++++++++++++++++++++++------- sepia-w3m.el | 62 +++++--------------------- sepia.el | 130 +++++++++++++++++++++++++++++-------------------------- 6 files changed, 223 insertions(+), 128 deletions(-) diff --git a/ChangeLog b/ChangeLog index ce8bf18..37b8a29 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2007-05-26 Sean O'Rourke <sorou...@cs.ucsd.edu> + + * VERSION: 0.74 + * 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). + (sepia-indent-expand-abbrev): control the above feature. + (sepia-complete-symbol): scroll completion buffer; suggested by + Hilko Bengen. + + * lib/Sepia.pm (html_package_list,html_module_list): new + functions. + (completions): '$'-completion only generates scalars. + + * sepia-w3m.el: remove spurious sepia-module-list, improve + 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. + 2007-05-23 Sean O'Rourke <sorou...@cs.ucsd.edu> * lib/Sepia.pm (_apropos_re): handle empty completions. diff --git a/META.yml b/META.yml index 60f7bd1..ef8e150 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: Sepia -version: 0.73 +version: 0.74 abstract: Simple Emacs-Perl InterAction license: perl generated_by: ExtUtils::MakeMaker version 6.31 diff --git a/debian/changelog b/debian/changelog index f89923e..b987433 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +sepia (0.74-1) unstable; urgency=low + + * New upstream version + + -- Hilko Bengen <ben...@debian.org> Mon, 28 May 2007 01:09:41 +0200 + sepia (0.73-2) unstable; urgency=low * Upstream fix for autocompletion (in general and for scalars in diff --git a/lib/Sepia.pm b/lib/Sepia.pm index 9c89d3d..1bd3eb5 100644 --- a/lib/Sepia.pm +++ b/lib/Sepia.pm @@ -17,7 +17,7 @@ At the prompt in the C<*perl-interaction*> buffer: =cut -$VERSION = '0.73'; +$VERSION = '0.74'; @ISA = qw(Exporter); require Exporter; @@ -63,6 +63,10 @@ development. This package contains the Perl side of the implementation, including all user-serviceable parts (for the cross-referencing facility see L<Sepia::Xref>). +Though not intended to be used independent of the Emacs interface, the +Sepia module's functionality can be used through a rough procedural +interface. + =head2 C<@compls = completions($string [, $type])> Find a list of completions for C<$string> with glob type $type. @@ -130,18 +134,18 @@ sub completions $type eq 'SCALAR' ? defined ${$_} : defined *{$_}{$type} } _completions $str; if (defined $infunc && defined *{$infunc}{CODE}) { - my ($apre) = _apropos_re($str); - my $st = $sigil{$type}; + my ($apre) = _apropos_re($str); + my $st = $sigil{$type}; push @ret, grep { - (my $tmp = $_) =~ s/^\Q$st//; - $tmp =~ /$apre/; - } lexicals($infunc); + (my $tmp = $_) =~ s/^\Q$st//; + $tmp =~ /$apre/; + } lexicals($infunc); } } - ## Complete "simple" sequences as abbreviations, e.g.: - ## wtci -> Want_To_Complete_It, NOT - ## -> WaTCh_trIpe + ## Complete "simple" sequences as abbreviations, e.g.: + ## wtci -> Want_To_Complete_It, NOT + ## -> WaTCh_trIpe if (!@ret && $str !~ /[^\w\d]/) { my $broad = join '.*', map "\\b$_", split '', $str; if ($type) { @@ -155,12 +159,12 @@ sub completions } _completions1 '::', qr/$broad/; } if (defined $infunc && defined *{$infunc}{CODE}) { - my $st = $sigil{$type}; - grep { - (my $tmp = $_) =~ s/^\Q$st//; + my $st = $sigil{$type}; + grep { + (my $tmp = $_) =~ s/^\Q$st//; $tmp =~ /$broad/; - } lexicals($infunc); - } + } lexicals($infunc); + } } ## XXX: Control characters, $", and $1, etc. confuse Emacs, so ## remove them. @@ -371,7 +375,7 @@ sub inst() sub package_list { - sort inst->modules; + sort { $a cmp $b } inst()->modules; } =head2 C<@mods = module_list> @@ -992,4 +996,100 @@ sub perl_eval tolisp(repl_eval(shift)); } +=head2 C<$status = html_module_list($file [, $prefix])> + +Generate an HTML list of installed modules, looking inside of +packages. If C<$prefix> is missing, uses "about://perldoc/". + +=head2 C<$status = html_package_list($file [, $prefix])> + +Generate an HTML list of installed top-level modules, without looking +inside of packages. If C<$prefix> is missing, uses +"about://perldoc/". + +=cut + +sub html_module_list +{ + my ($file, $base) = @_; + $base ||= 'about://perldoc/'; + my $inst = inst(); + return unless $inst; + return unless open OUT, ">$file"; + print "<html><body><ul>"; + my $pfx = ''; + my %ns; + for (package_list) { + push @{$ns{$1}}, $_ if /^([^:]+)/; + } + for (sort keys %ns) { + print qq{<li><b>$_</b><ul>} if @{$ns{$_}} > 1; + for (sort @{$ns{$_}}) { + my @fs = map { + s/.*man.\///; s|/|::|g; s/\..?pm//; $_ + } grep /\.\dpm$/, sort $inst->files($_); + if (@fs == 1) { + print qq{<li><a href="$base$fs[0]">$fs[0]</a>}; + } else { + print qq{<li>$_<ul>}; + for (@fs) { + print qq{<li><a href="$base$_">$_</a>}; + } + print '</ul>'; + } + } + print qq{</ul>} if @{$ns{$_}} > 1; + } + print "</ul></body></html>\n"; + close OUT; + 1; +} + +sub html_package_list +{ + my ($file, $base) = @_; + return unless inst(); + $base ||= 'about://perldoc/'; + return unless open OUT, ">$file"; + print OUT "<html><body><ul>"; + my $pfx = ''; + my %ns; + for (package_list) { + push @{$ns{$1}}, $_ if /^([^:]+)/; + } + for (sort keys %ns) { + if (@{$ns{$_}} == 1) { + print OUT + qq{<li><a href="$base$ns{$_}[0]">$ns{$_}[0]</a>}; + } else { + print OUT qq{<li><b>$_</b><ul>}; + print OUT qq{<li><a href="$base$_">$_</a>} + for sort @{$ns{$_}}; + print OUT qq{</ul>}; + } + } + print OUT "</ul></body></html>\n"; + close OUT; + 1; +} + 1; +__END__ + +=head1 TODO + +See the README file included with the distribution. + +=head1 AUTHOR + +Sean O'Rourke, E<lt>se...@cpan.orge<gt> + +Bug reports welcome, patches even more welcome. + +=head1 COPYRIGHT + +Copyright (C) 2005-2007 Sean O'Rourke. All rights reserved, some +wrongs reversed. This module is distributed under the same terms as +Perl itself. + +=cut diff --git a/sepia-w3m.el b/sepia-w3m.el index e8d58e8..fb26783 100644 --- a/sepia-w3m.el +++ b/sepia-w3m.el @@ -79,66 +79,26 @@ (w3m-perldoc mod)) (defun sepia-module-list () - "List installed (documented) modules in an HTML page, with -links to their documentation." + "List installed modules with links to their documentation. + +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) - (with-temp-buffer - (insert "use ExtUtils::Installed; - -print \"<html><body><ul>\"; -my $inst = new ExtUtils::Installed; -for (sort $inst->modules) { - print qq{<li>$_<ul>}; - for (sort $inst->files($_)) { - if (/\\.\\dpm$/) { - s/.*man.\\///; s|/|::|g;s/\..?pm//; - print qq{<li><a href=\"about://perldoc/$_\">$_</a>}; - } - } - print '</ul>'; -} -print \"</ul></body></html>\n\"; -") - (shell-command-on-region (point-min) (point-max) - (concat "perl > " file)))) + (sepia-eval (format "Sepia::html_module_list(\"%s\")" file))) (w3m-find-file file))) (defun sepia-package-list () - "List installed modules in an HTML page, with links to their documentation." - (interactive) - (let ((file "/tmp/packlist.html")) - (unless (file-exists-p file) - (with-temp-buffer - (insert "use ExtUtils::Installed; - -print \"<html><body><ul>\"; -for (sort ExtUtils::Installed->new->modules) { - print qq{<li><a href=\"about://perldoc/$_\">$_</a>}; -} -print \"</ul></body></html>\n\"; -") - (shell-command-on-region (point-min) (point-max) - (concat "perl > " file)))) - (w3m-find-file file))) + "List installed packages with links to their documentation. -(defun sepia-module-list () - "List installed modules in an HTML page, 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/modlist.html")) + (let ((file "/tmp/packlist.html")) (unless (file-exists-p file) - (with-temp-buffer - (insert "use ExtUtils::Installed; - -print \"<html><body><ul>\"; -for (sort ExtUtils::Installed->new->modules) { - print qq{<li><a href=\"about://perldoc/$_\">$_</a>}; -} -print \"</ul></body></html>\n\"; -") - (shell-command-on-region (point-min) (point-max) - (concat "perl > " file)))) + (sepia-eval (format "Sepia::html_package_list(\"%s\")" file))) (w3m-find-file file))) (provide 'sepia-w3m) diff --git a/sepia.el b/sepia.el index 1276d86..edef7ce 100644 --- a/sepia.el +++ b/sepia.el @@ -801,57 +801,59 @@ The function is intended to be bound to \\M-TAB, like ``lisp-complete-symbol''." (interactive) (let ((win (get-buffer-window "*Completions*" 0))) - (when (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. - (with-current-buffer (window-buffer win) - (if (pos-visible-in-window-p (point-max) win) - (set-window-start win (point-min)) - (save-selected-window - (select-window win) - (scroll-up)))) - (return t)) - - (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))) - ))) + (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. + (with-current-buffer (window-buffer win) + (if (pos-visible-in-window-p (point-max) win) + (set-window-start win (point-min)) + (save-selected-window + (select-window win) + (scroll-up)))) + + (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))) + )))) + +(defvar sepia-indent-expand-abbrev t +"* If non-NIL, `sepia-indent-or-complete' tries `expand-abbrev'.") (defun sepia-indent-or-complete () "Indent the current line or complete the symbol around point. @@ -863,11 +865,13 @@ This function is intended to be bound to TAB." (let (beginning-of-defun-function end-of-defun-function) (cperl-indent-command)) - (when (and (= pos (point)) - (not (bolp)) - (or (eq last-command 'sepia-indent-or-complete) - (looking-at "\\_>"))) - (sepia-complete-symbol)))) + (unless (or (not sepia-indent-expand-abbrev) + (expand-abbrev)) + (when (and (= pos (point)) + (not (bolp)) + (or (eq last-command 'sepia-indent-or-complete) + (looking-at "\\_>"))) + (sepia-complete-symbol))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; scratchpad code @@ -1041,13 +1045,12 @@ With prefix arg, replace the region with the result." (save-excursion (goto-char (point-min)) (loop while (re-search-forward - "^=\\(item\\|head2\\)\\s +\\([%$&@A-Za-z_].*\\)" nil t) + "^=\\(item\\|head[2-9]\\)\\s +\\([%$&@A-Za-z_].*\\)" nil t) if (ignore-errors (let* ((s1 (match-string 2)) (s2 (let ((case-fold-search nil)) (replace-regexp-in-string - "[A-Z]<\\([^>]+\\)>" - (lambda (x) (match-string 1 s1)) s1))) + "[A-Z]<\\([^>]+\\)>" "\\1" s1))) (longdoc (let ((beg (progn (forward-line 2) (point))) (end (1- (re-search-forward "^=" nil t)))) @@ -1060,11 +1063,16 @@ With prefix arg, replace the region with the result." 0 (position ?. (match-string 1)))) s2)))) (cond + ;; e.g. "$x -- this is x" + ((string-match "^[%$@]\\([A-Za-z0-9_:]+\\)\\s *--\\s *\\(.*\\)" + s2) + (list 'variable (match-string-no-properties 1 s2) + (or (and (equal s2 (match-string 1 s2)) longdoc) s2))) ;; e.g. "C<foo(BLAH)>" or "$x = $y->foo()" - ((string-match "\\([A-Za-z0-9_]+\\)\\s *\\($\\|(\\)" s2) + ((string-match "\\([A-Za-z0-9_:]+\\)\\s *\\(\\$\\|(\\)" s2) (list 'function (match-string-no-properties 1 s2) (or (and (equal s2 (match-string 1 s2)) longdoc) s2))) - ;; e.g. "$x -- this is x" (note: this has to come second) + ;; e.g. "$x this is x" (note: this has to come last) ((string-match "^[%$@]\\([^( ]+\\)" s2) (list 'variable (match-string-no-properties 1 s2) longdoc))))) collect it))) -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/sepia.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits