[sepia] 09/63: Imported Debian patch 0.74-1
Hilko Bengen
bengen at moszumanska.debian.org
Sat Aug 8 11:20:33 UTC 2015
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 <bengen at 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 <sorourke at 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 <sorourke at 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 <bengen at 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>seano at 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
More information about the Pkg-perl-cvs-commits
mailing list