[Emacs-diffs] /srv/bzr/emacs/trunk r112481: * lisp/progmodes/perl-mode.el: Add support for here documents.

[Stefan Monnier]

------------------------------------------------------------
revno: 112481
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2013-05-06 15:33:56 -0400
message:
  * 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:].
modified:
  lisp/ChangeLog
  lisp/progmodes/perl-mode.el
  test/indent/perl.perl

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-05-06 15:27:11 +0000
+++ b/lisp/ChangeLog    2013-05-06 19:33:56 +0000
@@ -1,5 +1,10 @@
 2013-05-06  Stefan Monnier  <address@hidden>
 
+       * 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).

=== modified file 'lisp/progmodes/perl-mode.el'
--- a/lisp/progmodes/perl-mode.el       2013-01-02 16:13:04 +0000
+++ b/lisp/progmodes/perl-mode.el       2013-05-06 19:33:56 +0000
@@ -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-+\\(address@hidden:]+\\)\\s-*=" 1)
-    ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1)
+    ("Variables" 
"^\\(?:my\\|our\\)\\s-+\\(address@hidden: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 @@
   (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 @@
       ;; 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 @@
                                            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 @@
   (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.

=== modified file 'test/indent/perl.perl'
--- a/test/indent/perl.perl     2012-10-31 02:45:34 +0000
+++ b/test/indent/perl.perl     2013-05-06 19:33:56 +0000
@@ -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}} );