Subject: bug#15848: 24.3.50; cperl-mode + which-function: Improve reporting (corner case)

From: Nathan Trapuzzano <[email-masked]>
Date: Tue, 12 Nov 2013 09:11:02 -0500

Jambunathan K <[email-masked]> writes:

Try this patch.  It includes the patch for the variable I added earlier.

Also, don't try to apply this on top of the patch I sent for the outline
problem.  You'll get conflicts.  I'll wait till that patch gets
installed and then resolve the conflicts with this patch and send an
updated one.

# Bazaar merge directive format 2 (Bazaar 0.90)
# revision_id: [email-masked]
# target_branch: file:///home/nathan/opt/etc/bzr-repos/emacs/trunk/
# testament_sha1: 6e81494670e3d66dc1c7cb0abd95be7a9831a403
# timestamp: 2013-11-12 09:05:04 -0500
# base_revision_id: [email-masked]
# 
# Begin patch
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2013-11-10 08:35:04 +0000
+++ lisp/ChangeLog	2013-11-12 14:03:20 +0000
@@ -1,3 +1,17 @@
+2013-11-12  Nathan Trapuzzano  <[email-masked]>
+
+	* progmodes/cperl-mode.el (cperl-imenu--function-name-regexp-perl)
+	(cperl-outline-level, cperl-imeny--create-perl-index): Index imenu
+	definitions with the positions at which they begin instead of
+	their end positions.  (Bug#15848)
+
+2013-11-10  Nathan Trapuzzano  <[email-masked]>
+
+	* progmodes/cperl-mode.el (cperl-imenu-index-pod)
+	(cperl-imenu--create-perl-index): Define and implement
+	`cperl-imenu-index-pod' to optionally disable cperl's indexing of
+	POD directives for imenu.  (Bug#15848)
+
 2013-11-10  Michael Albinus  <[email-masked]>
 
 	* net/tramp.el (tramp-methods):

=== modified file 'lisp/progmodes/cperl-mode.el'
--- lisp/progmodes/cperl-mode.el	2013-11-04 03:44:23 +0000
+++ lisp/progmodes/cperl-mode.el	2013-11-12 13:26:52 +0000
@@ -511,6 +511,13 @@
   :type 'boolean
   :group 'cperl-help-system)
 
+(defcustom cperl-imenu-index-pod t
+  "*Whether POD `=head' directives should be indexed by imenu.
+Non-nil means `which-function-mode' won't count POD directives as
+top-level definitions."
+  :type 'boolean
+  :group 'cperl-help-system)
+
 (defcustom cperl-max-help-size 66
   "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents."
   :type '(choice integer (const nil))
@@ -844,7 +851,8 @@
                 interactive sweep over the buffer);
         d) Has support for imenu, including:
                 1) Separate unordered list of \"interesting places\";
-                2) Separate TOC of POD sections;
+                2) Separate TOC of POD sections by default
+                   (cf. `cperl-imenu-index-pod');
                 3) Separate list of packages;
                 4) Hierarchical view of methods in (sub)packages;
                 5) and functions (by the full name - with package);
@@ -1439,7 +1447,7 @@
 
 ;;; Details of groups in this are used in `cperl-imenu--create-perl-index'
 ;;;  and `cperl-outline-level'.
-;;;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3)
+;;;; Was: 2=sub|package; now 2=package-group, 5=package-name 9=sub-name (+4)
 (defvar cperl-imenu--function-name-regexp-perl
   (concat
    "^\\("				; 1 = all
@@ -1448,12 +1456,13 @@
 	    cperl-white-and-comment-rex ; 4 = pre-package-name
 	       "\\([a-zA-Z_0-9:']+\\)\\)?\\)" ; 5 = package-name
        "\\|"
-          "[ \t]*sub"
-	  (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
-	  cperl-maybe-white-and-comment-rex	; 15=pre-block
+          "\\([ \t]*sub"
+	  (cperl-after-sub-regexp 'named nil) ; 9=name 12=proto 15=attr-start
+	  cperl-maybe-white-and-comment-rex	; 16=pre-block
+          "\\)"
    "\\|"
-     "=head\\([1-4]\\)[ \t]+"		; 16=level
-     "\\([^\n]+\\)$"			; 17=text
+     "=head\\([1-4]\\)[ \t]+"		; 17=level
+     "\\([^\n]+\\)$"			; 18=text
    "\\)"))
 
 (defvar cperl-outline-regexp
@@ -5486,17 +5495,16 @@
       (while (re-search-forward
 	      (or regexp cperl-imenu--function-name-regexp-perl)
 	      nil t)
-	;; 2=package-group, 5=package-name 8=sub-name
+	;; 2=package-group, 5=package-name 9=sub-name
 	(cond
 	 ((and				; Skip some noise if building tags
 	   (match-beginning 5)		; package name
 	   ;;(eq (char-after (match-beginning 2)) ?p) ; package
-	   (not (save-match-data
-		  (looking-at "[ \t\n]*;")))) ; Plain text word 'package'
+	   (not (looking-at-p "[ \t\n]*;"))) ; Plain text word 'package'
 	  nil)
 	 ((and
 	   (or (match-beginning 2)
-	       (match-beginning 8))		; package or sub
+	       (match-beginning 9))		; package or sub
 	   ;; Skip if quoted (will not skip multi-line ''-strings :-():
 	   (null (get-text-property (match-beginning 1) 'syntax-table))
 	   (null (get-text-property (match-beginning 1) 'syntax-type))
@@ -5535,10 +5543,13 @@
 	  (if (and is-proto (not is-pack)) nil
 	    (or is-pack
 		(setq name
-		      (buffer-substring (match-beginning 8) (match-end 8)))
+		      (buffer-substring (match-beginning 9) (match-end 9)))
 		(set-text-properties 0 (length name) nil name))
 	    (setq marker (make-marker))
-	    (set-marker marker (match-end (if is-pack 2 8)))
+	    (set-marker marker (save-excursion
+                                 (goto-char (match-beginning (if is-pack 2 6)))
+                                 (skip-chars-forward " \t")
+                                 (point)))
 	    (cond (is-pack nil)
 		  ((string-match "[:']" name)
 		   (setq meth t))
@@ -5551,13 +5562,13 @@
 	      (push index index-alist))
 	    (if meth (push index index-meth-alist))
 	    (push index index-unsorted-alist)))
-	 ((match-beginning 16)		; POD section
-	  (setq name (buffer-substring (match-beginning 17) (match-end 17))
+	 ((and cperl-imenu-index-pod (match-beginning 17))	; POD section
+	  (setq name (buffer-substring (match-beginning 18) (match-end 18))
 		marker (make-marker))
-	  (set-marker marker (match-beginning 17))
+	  (set-marker marker (- (match-beginning 17) 5))
 	  (set-text-properties 0 (length name) nil name)
 	  (setq name (concat (make-string
-			      (* 3 (- (char-after (match-beginning 16)) ?1))
+			      (* 3 (- (char-after (match-beginning 17)) ?1))
 			      ?\ )
 			     name)
 		index (cons name marker))
@@ -5624,11 +5635,11 @@
 (defun cperl-outline-level ()
   (looking-at outline-regexp)
   (cond ((not (match-beginning 1)) 0)	; beginning-of-file
-;;;; 2=package-group, 5=package-name 8=sub-name 16=head-level
+;;;; 2=package-group, 5=package-name 9=sub-name 17=head-level
 	((match-beginning 2) 0)		; package
-	((match-beginning 8) 1)		; sub
-	((match-beginning 16)
-	 (- (char-after (match-beginning 16)) ?0)) ; headN ==> N
+	((match-beginning 9) 1)		; sub
+	((match-beginning 17)
+	 (- (char-after (match-beginning 17)) ?0)) ; headN ==> N
 	(t 5)))				; should not happen
 
 

# Begin bundle
FbZA