From 323885fd82df508666a26527365b862239b9135d Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 6 May 2013 15:33:56 -0400
Subject: [PATCH] * lisp/progmodes/perl-mode.el: Add support for here
 documents. (perl-syntax-propertize-function): Match here-doc markers.
 (perl-syntax-propertize-special-constructs): Find their end.
 (perl-imenu-generic-expression): Use [:alnum:].

---
 lisp/ChangeLog              |  5 +++++
 lisp/progmodes/perl-mode.el | 49 +++++++++++++++++++++++++++++++++++++++------
 test/indent/perl.perl       | 15 ++++++++++++++
 3 files changed, 63 insertions(+), 6 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dd7b8456368..72036ac1a2e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2013-05-06  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* progmodes/perl-mode.el: Add support for here documents.
+	(perl-syntax-propertize-function): Match here-doc markers.
+	(perl-syntax-propertize-special-constructs): Find their end.
+	(perl-imenu-generic-expression): Use [:alnum:].
+
 	* emacs-lisp/nadvice.el (advice--member-p): Return the advice if found.
 	(advice--add-function): Refresh the advice if already present
 	(bug#14317).
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index bd58a7300ec..e5c8215faf3 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -148,10 +148,10 @@
 
 (defvar perl-imenu-generic-expression
   '(;; Functions
-    (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1)
+    (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1)
     ;;Variables
-    ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1)
-    ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1)
+    ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1)
+    ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1)
     ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
   "Imenu generic expression for Perl mode.  See `imenu-generic-expression'.")
 
@@ -275,7 +275,6 @@ Regexp match data 0 points to the chars."
   (let ((case-fold-search nil))
     (goto-char start)
     (perl-syntax-propertize-special-constructs end)
-    ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
     (funcall
      (syntax-propertize-rules
       ;; Turn POD into b-style comments.  Place the cut rule first since it's
@@ -287,7 +286,7 @@ Regexp match data 0 points to the chars."
       ;; check that it occurs inside a '..' string.
       ("\\(\\$\\)[{']" (1 ". p"))
       ;; Handle funny names like $DB'stop.
-      ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
+      ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
       ;; format statements
       ("^[ \t]*format.*=[ \t]*\\(\n\\)"
        (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
@@ -345,7 +344,29 @@ Regexp match data 0 points to the chars."
                                            perl-quote-like-pairs)
                                     (string-to-syntax "|")
                                   (string-to-syntax "\"")))
-             (perl-syntax-propertize-special-constructs end))))))
+             (perl-syntax-propertize-special-constructs end)))))
+      ;; Here documents.
+      ;; TODO: Handle <<WORD.  These are trickier because you need to
+      ;; disambiguate with the shift operator.
+      ("<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\).*\\(\n\\)"
+       (2 (let* ((st (get-text-property (match-beginning 2) 'syntax-table))
+                 (name (match-string 1)))
+            (goto-char (match-end 1))
+            (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+                ;; Leave the property of the newline unchanged.
+                st
+              (cons (car (string-to-syntax "< c"))
+                    ;; Remember the names of heredocs found on this line.
+                    (cons (pcase (aref name 0)
+                            (`?\\ (substring name 1))
+                            (_ (substring name 1 -1)))
+                          (cdr st)))))))
+      ;; We don't call perl-syntax-propertize-special-constructs directly
+      ;; from the << rule, because there might be other elements (between
+      ;; the << and the \n) that need to be propertized.
+      ("\\(?:$\\)\\s<"
+       (0 (ignore (perl-syntax-propertize-special-constructs end))))
+      )
      (point) end)))
 
 (defvar perl-empty-syntax-table
@@ -370,6 +391,22 @@ Regexp match data 0 points to the chars."
   (let ((state (syntax-ppss))
         char)
     (cond
+     ((eq 2 (nth 7 state))
+      ;; A Here document.
+      (let ((names (cdr (get-text-property (nth 8 state) 'syntax-table))))
+        (when (cdr names)
+          (setq names (reverse names))
+          ;; Multiple heredocs on a single line, we have to search from the
+          ;; beginning, since we don't know which names might be
+          ;; before point.
+          (goto-char (nth 8 state)))
+        (while (and names
+                    (re-search-forward
+                     (concat "^" (regexp-quote (pop names)) "\n")
+                     limit 'move))
+          (unless names
+            (put-text-property (1- (point)) (point) 'syntax-table
+                               (string-to-syntax "> c"))))))
      ((or (null (setq char (nth 3 state)))
           (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
       ;; Normal text, or comment, or docstring, or normal string.
diff --git a/test/indent/perl.perl b/test/indent/perl.perl
index 2411c96a5e4..69c1f90c807 100755
--- a/test/indent/perl.perl
+++ b/test/indent/perl.perl
@@ -1,5 +1,20 @@
 #!/usr/bin/perl
 # -*- eval: (bug-reference-mode 1) -*-
 
+print <<"EOF1" . s/he"llo/th'ere/;
+foo
+EOF2
+bar
+EOF1
+
+
+print <<"EOF1" . <<\EOF2 . s/he"llo/th'ere/;
+foo
+EOF2
+bar
+EOF1
+bar
+EOF2
+
 $fileType_filesButNot           # bug#12373?
     = join( '|', map { quotemeta($_).'$' } @{$fileType->{filesButNot}} );
-- 
2.11.4.GIT