Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

10 files changed, 213 insertions, 142 deletions

diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 121ba24f090..dec59c58090 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1843,19 +1843,25 @@ with a brace block."
           (unless (eq where 'at-header)
             (c-backward-to-nth-BOF-{ 1 where)
             (c-beginning-of-decl-1))
+          (when (looking-at c-typedef-key)
+            (goto-char (match-end 0))
+            (c-forward-syntactic-ws))
 
           ;; Pick out the defun name, according to the type of defun.
           (cond
            ;; struct, union, enum, or similar:
-           ((and (looking-at c-type-prefix-key)
-                 (progn (c-forward-token-2 2) ; over "struct foo "
-                        (or (eq (char-after) ?\{)
-                            (looking-at c-symbol-key)))) ; "struct foo bar ..."
-            (save-match-data (c-forward-token-2))
-            (when (eq (char-after) ?\{)
-              (c-backward-token-2)
-              (looking-at c-symbol-key))
-            (match-string-no-properties 0))
+           ((looking-at c-type-prefix-key)
+            (let ((key-pos (point)))
+              (c-forward-token-2 1)     ; over "struct ".
+              (cond
+               ((looking-at c-symbol-key)       ; "struct foo { ..."
+                (buffer-substring-no-properties key-pos (match-end 0)))
+               ((eq (char-after) ?{)    ; "struct { ... } foo"
+                (when (c-go-list-forward)
+                  (c-forward-syntactic-ws)
+                  (when (looking-at c-symbol-key) ; a bit bogus - there might
+                                                  ; be several identifiers.
+                    (match-string-no-properties 0)))))))
 
            ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs!
             ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory
@@ -1900,7 +1906,8 @@ with a brace block."
                 (c-backward-syntactic-ws))
               (setq name-end (point))
               (c-back-over-compound-identifier)
-              (buffer-substring-no-properties (point) name-end)))))))))
+              (and (looking-at c-symbol-start)
+                   (buffer-substring-no-properties (point) name-end))))))))))
 
 (defun c-declaration-limits (near)
   ;; Return a cons of the beginning and end positions of the current
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index eb7bde0f767..ab910ab7dec 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -417,6 +417,17 @@ to it is returned.  This function does not modify the point or the mark."
     ;; Emacs.
     `(setq mark-active ,activate)))
 
+(defmacro c-set-keymap-parent (map parent)
+  (cond
+   ;; XEmacs
+   ((cc-bytecomp-fboundp 'set-keymap-parents)
+    `(set-keymap-parents ,map ,parent))
+   ;; Emacs
+   ((cc-bytecomp-fboundp 'set-keymap-parent)
+    `(set-keymap-parent ,map ,parent))
+   ;; incompatible
+   (t (error "CC Mode is incompatible with this version of Emacs"))))
+
 (defmacro c-delete-and-extract-region (start end)
   "Delete the text between START and END and return it."
   (if (cc-bytecomp-fboundp 'delete-and-extract-region)
@@ -1266,6 +1277,7 @@ with value CHAR in the region [FROM to)."
 (def-edebug-spec cc-eval-when-compile (&rest def-form))
 (def-edebug-spec c-point t)
 (def-edebug-spec c-set-region-active t)
+(def-edebug-spec c-set-keymap-parent t)
 (def-edebug-spec c-safe t)
 (def-edebug-spec c-save-buffer-state let*)
 (def-edebug-spec c-tentative-buffer-changes t)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e880bd39321..59dc96af030 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -6089,7 +6089,8 @@ comment at the start of cc-engine.el for more info."
 
 (defsubst c-clear-found-types ()
   ;; Clears `c-found-types'.
-  (setq c-found-types (make-vector 53 0)))
+  (setq c-found-types
+        (make-hash-table :test #'equal :weakness nil)))
 
 (defun c-add-type (from to)
   ;; Add the given region as a type in `c-found-types'.  If the region
@@ -6103,29 +6104,27 @@ comment at the start of cc-engine.el for more info."
   ;;
   ;; This function might do hidden buffer changes.
   (let ((type (c-syntactic-content from to c-recognize-<>-arglists)))
-    (unless (intern-soft type c-found-types)
-      (unintern (substring type 0 -1) c-found-types)
-      (intern type c-found-types))))
+    (unless (gethash type c-found-types)
+      (remhash (substring type 0 -1) c-found-types)
+      (puthash type t c-found-types))))
 
 (defun c-unfind-type (name)
   ;; Remove the "NAME" from c-found-types, if present.
-  (unintern name c-found-types))
+  (remhash name c-found-types))
 
 (defsubst c-check-type (from to)
   ;; Return non-nil if the given region contains a type in
   ;; `c-found-types'.
   ;;
   ;; This function might do hidden buffer changes.
-  (intern-soft (c-syntactic-content from to c-recognize-<>-arglists)
-               c-found-types))
+  (gethash (c-syntactic-content from to c-recognize-<>-arglists) c-found-types))
 
 (defun c-list-found-types ()
   ;; Return all the types in `c-found-types' as a sorted list of
   ;; strings.
   (let (type-list)
-    (mapatoms (lambda (type)
-                (setq type-list (cons (symbol-name type)
-                                      type-list)))
+    (maphash (lambda (type _)
+               (setq type-list (cons type type-list)))
               c-found-types)
     (sort type-list 'string-lessp)))
 
@@ -7059,6 +7058,7 @@ comment at the start of cc-engine.el for more info."
   ;; This function might do hidden buffer changes.
 
   (let ((start (point))
+        (old-found-types (copy-hash-table c-found-types))
         ;; If `c-record-type-identifiers' is set then activate
         ;; recording of any found types that constitute an argument in
         ;; the arglist.
@@ -7074,6 +7074,7 @@ comment at the start of cc-engine.el for more info."
                   (nconc c-record-found-types c-record-type-identifiers)))
           t)
 
+      (setq c-found-types old-found-types)
       (goto-char start)
       nil)))
 
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 9b89681c3bf..bf0439ffe8a 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -225,18 +225,7 @@ control).  See \"cc-mode.el\" for more info."
 
 (defun c-make-inherited-keymap ()
   (let ((map (make-sparse-keymap)))
-    ;; Necessary to use `cc-bytecomp-fboundp' below since this
-    ;; function is called from top-level forms that are evaluated
-    ;; while cc-bytecomp is active when one does M-x eval-buffer.
-    (cond
-     ;; Emacs
-     ((cc-bytecomp-fboundp 'set-keymap-parent)
-      (set-keymap-parent map c-mode-base-map))
-     ;; XEmacs
-     ((fboundp 'set-keymap-parents)
-      (set-keymap-parents map c-mode-base-map))
-     ;; incompatible
-     (t (error "CC Mode is incompatible with this version of Emacs")))
+    (c-set-keymap-parent map c-mode-base-map)
     map))
 
 (defun c-define-abbrev-table (name defs &optional doc)
@@ -276,6 +265,8 @@ control).  See \"cc-mode.el\" for more info."
     nil
 
   (setq c-mode-base-map (make-sparse-keymap))
+  (when (boundp 'prog-mode-map)
+    (c-set-keymap-parent c-mode-base-map prog-mode-map))
 
   ;; Separate M-BS from C-M-h.  The former should remain
   ;; backward-kill-word.
@@ -446,27 +437,36 @@ preferably use the `c-mode-menu' language constant directly."
         t))))
 
 (defun c-unfind-coalesced-tokens (beg end)
-  ;; unless the non-empty region (beg end) is entirely WS and there's at
-  ;; least one character of WS just before or after this region, remove
-  ;; the tokens which touch the region from `c-found-types' should they
-  ;; be present.
-  (or (c-partial-ws-p beg end)
-      (save-excursion
-        (progn
-          (goto-char beg)
-          (or (eq beg (point-min))
-              (c-skip-ws-backward (1- beg))
-              (/= (point) beg)
-              (= (c-backward-token-2) 1)
-              (c-unfind-type (buffer-substring-no-properties
-                              (point) beg)))
-          (goto-char end)
-          (or (eq end (point-max))
-              (c-skip-ws-forward (1+ end))
-              (/= (point) end)
-              (progn (forward-char) (c-end-of-current-token) nil)
-              (c-unfind-type (buffer-substring-no-properties
-                              end (point))))))))
+  ;; If removing the region (beg end) would coalesce an identifier ending at
+  ;; beg with an identifier (fragment) beginning at end, or an identifier
+  ;; fragment ending at beg with an identifier beginning at end, remove the
+  ;; pertinent identifier(s) from `c-found-types'.
+  (save-excursion
+    (when (< beg end)
+      (goto-char beg)
+      (when
+          (and (not (bobp))
+               (progn (c-backward-syntactic-ws) (eq (point) beg))
+               (/= (skip-chars-backward c-symbol-chars (1- (point))) 0)
+               (progn (goto-char beg) (c-forward-syntactic-ws) (<= (point) end))
+               (> (point) beg)
+               (goto-char end)
+               (looking-at c-symbol-char-key))
+        (goto-char beg)
+        (c-simple-skip-symbol-backward)
+        (c-unfind-type (buffer-substring-no-properties (point) beg)))
+
+      (goto-char end)
+      (when
+          (and (not (eobp))
+               (progn (c-forward-syntactic-ws) (eq (point) end))
+               (looking-at c-symbol-char-key)
+               (progn (c-backward-syntactic-ws) (>= (point) beg))
+               (< (point) end)
+               (/= (skip-chars-backward c-symbol-chars (1- (point))) 0))
+        (goto-char (1+ end))
+        (c-end-of-current-token)
+        (c-unfind-type (buffer-substring-no-properties end (point)))))))
 
 ;; c-maybe-stale-found-type records a place near the region being
 ;; changed where an element of `found-types' might become stale.  It
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index c0f1aaf39d4..c69eca22413 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -3734,7 +3734,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
            "\\(\\`\n?\\|^\n\\)="        ; POD
            "\\|"
            ;; One extra () before this:
-           "<<"                         ; HERE-DOC
+           "<<~?"                       ; HERE-DOC
            "\\("                        ; 1 + 1
            ;; First variant "BLAH" or just ``.
            "[ \t]*"                     ; Yes, whitespace is allowed!
@@ -4000,7 +4000,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                   (setq b (point))
                   ;; We do not search to max, since we may be called from
                   ;; some hook of fontification, and max is random
-                  (or (and (re-search-forward (concat "^" qtag "$")
+                  (or (and (re-search-forward (concat "^[ \t]*" qtag "$")
                                               stop-point 'toend)
                            ;;;(eq (following-char) ?\n) ; XXXX WHY???
                            )
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index da148bd39aa..7c040e74955 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -83,13 +83,21 @@ When this is `function', only ask when called non-interactively."
   :type 'regexp
   :group 'executable)
 
-
 (defcustom executable-prefix "#!"
-  "Interpreter magic number prefix inserted when there was no magic number."
-  :version "24.3"                       ; "#! " -> "#!"
+  "Interpreter magic number prefix inserted when there was no magic number.
+Use of `executable-prefix-env' is preferable to this option."
+  :version "26.1"                       ; deprecated
   :type 'string
   :group 'executable)
 
+(defcustom executable-prefix-env nil
+  "If non-nil, use \"/usr/bin/env\" in interpreter magic number.
+If this variable is non-nil, the interpreter magic number inserted
+by `executable-set-magic' will be \"#!/usr/bin/env INTERPRETER\",
+otherwise it will be \"#!/path/to/INTERPRETER\"."
+  :version "26.1"
+  :type 'boolean
+  :group 'executable)
 
 (defcustom executable-chmod 73
   "After saving, if the file is not executable, set this mode.
@@ -199,7 +207,7 @@ command to find the next error.  The buffer is also in `comint-mode' and
 (defun executable-set-magic (interpreter &optional argument
                                          no-query-flag insert-flag)
   "Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
-The variables `executable-magicless-file-regexp', `executable-prefix',
+The variables `executable-magicless-file-regexp', `executable-prefix-env',
 `executable-insert', `executable-query' and `executable-chmod' control
 when and how magic numbers are inserted or replaced and scripts made
 executable."
@@ -220,6 +228,14 @@ executable."
                          (and argument (string< "" argument) " ")
                          argument))
 
+  ;; For backward compatibilty, allow `executable-prefix-env' to be
+  ;; overriden by custom `executable-prefix'.
+  (if (string-match "#!\\([ \t]*/usr/bin/env[ \t]*\\)?$" executable-prefix)
+      (if executable-prefix-env
+          (setq argument (concat "/usr/bin/env "
+                                 (file-name-nondirectory argument))))
+    (setq argument (concat (substring executable-prefix 2) argument)))
+
   (or buffer-read-only
       (if buffer-file-name
           (string-match executable-magicless-file-regexp
@@ -241,15 +257,13 @@ executable."
                            ;; Make buffer visible before question.
                            (switch-to-buffer (current-buffer))
                            (y-or-n-p (format-message
-                                      "Replace magic number by `%s%s'? "
-                                      executable-prefix argument))))
+                                      "Replace magic number by `#!%s'? "
+                                      argument))))
                      (progn
                        (replace-match argument t t nil 1)
-                       (message "Magic number changed to `%s'"
-                                (concat executable-prefix argument)))))
-          (insert executable-prefix argument ?\n)
-          (message "Magic number changed to `%s'"
-                   (concat executable-prefix argument)))))
+                       (message "Magic number changed to `#!%s'" argument))))
+          (insert "#!" argument ?\n)
+          (message "Magic number changed to `#!%s'" argument))))
     interpreter)
 
 
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index b3d8a51ceeb..2ddaf884bce 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -47,8 +47,8 @@ to avoid computing them again.")
 (defun grep-apply-setting (symbol value)
   "Set SYMBOL to VALUE, and update `grep-host-defaults-alist'.
 SYMBOL should be one of `grep-command', `grep-template',
-`grep-use-null-device', `grep-find-command',
-`grep-find-template', `grep-find-use-xargs', or
+`grep-use-null-device', `grep-find-command' `grep-find-template',
+`grep-find-use-xargs', `grep-use-null-filename-separator', or
 `grep-highlight-matches'."
   (when grep-host-defaults-alist
     (let* ((host-id
@@ -160,6 +160,15 @@ Customize or call the function `grep-apply-setting'."
   :set 'grep-apply-setting
   :group 'grep)
 
+(defcustom grep-use-null-filename-separator 'auto-detect
+  "If non-nil, use `grep's `--null' option.
+This is done to disambiguate file names in `grep's output."
+  :type '(choice (const :tag "Do Not Use `--null'" nil)
+                 (const :tag "Use `--null'" t)
+                 (other :tag "Not Set" auto-detect))
+  :set 'grep-apply-setting
+  :group 'grep)
+
 ;;;###autoload
 (defcustom grep-find-command nil
   "The default find command for \\[grep-find].
@@ -357,33 +366,53 @@ A grep buffer becomes most recent when you select Grep mode in it.
 Notice that using \\[next-error] or \\[compile-goto-error] modifies
 `compilation-last-buffer' rather than `grep-last-buffer'.")
 
-;;;###autoload
-(defconst grep-regexp-alist
-  '(
-    ;; Use a tight regexp to handle weird file names (with colons
+(defconst grep--regexp-alist-column
+  ;; Calculate column positions (col . end-col) of first grep match on a line
+  (cons
+   (lambda ()
+     (when grep-highlight-matches
+       (let* ((beg (match-end 0))
+              (end (save-excursion (goto-char beg) (line-end-position)))
+              (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)))
+         (when mbeg
+           (- mbeg beg)))))
+   (lambda ()
+     (when grep-highlight-matches
+       (let* ((beg (match-end 0))
+              (end (save-excursion (goto-char beg) (line-end-position)))
+              (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))
+              (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end))))
+         (when mend
+           (- mend beg)))))))
+(defconst grep--regexp-alist-bin-matcher
+  '("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
+(defconst grep-with-null-regexp-alist
+  `(("^\\([^\0]+\\)\\(\0\\)\\([0-9]+\\):" 1 3 ,grep--regexp-alist-column nil nil
+     (2 '(face unspecified display ":")))
+    ,grep--regexp-alist-bin-matcher)
+  "Regexp used to match grep hits.
+See `compilation-error-regexp-alist'.")
+(defconst grep-fallback-regexp-alist
+  `(;; Use a tight regexp to handle weird file names (with colons
     ;; in them) as well as possible.  E.g., use [1-9][0-9]* rather
     ;; than [0-9]+ so as to accept ":034:" in file names.
     ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:"
-     1 2
-     ;; Calculate column positions (col . end-col) of first grep match on a line
-     ((lambda ()
-        (when grep-highlight-matches
-          (let* ((beg (match-end 0))
-                 (end (save-excursion (goto-char beg) (line-end-position)))
-                 (mbeg (text-property-any beg end 'font-lock-face grep-match-face)))
-            (when mbeg
-              (- mbeg beg)))))
-      .
-      (lambda ()
-        (when grep-highlight-matches
-          (let* ((beg (match-end 0))
-                 (end (save-excursion (goto-char beg) (line-end-position)))
-                 (mbeg (text-property-any beg end 'font-lock-face grep-match-face))
-                 (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end))))
-            (when mend
-              (- mend beg)))))))
-    ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
-  "Regexp used to match grep hits.  See `compilation-error-regexp-alist'.")
+     1 2 ,grep--regexp-alist-column)
+    ,grep--regexp-alist-bin-matcher)
+  "Regexp used to match grep hits when `--null' is not supported.
+See `compilation-error-regexp-alist'.")
+
+(defvaralias 'grep-regex-alist 'grep-with-null-regexp-alist)
+(make-obsolete-variable
+ 'grep-regex-alist "Call `grep-regexp-alist' instead." "26.1")
+
+;;;###autoload
+(defun grep-regexp-alist ()
+  "Return a regexp alist to match grep hits.
+The regexp used depends on `grep-use-null-filename-separator'.
+See `compilation-error-regexp-alist' for format details."
+  (if grep-use-null-filename-separator
+      grep-with-null-regexp-alist grep-fallback-regexp-alist))
 
 (defvar grep-first-column 0             ; bug#10594
   "Value to use for `compilation-first-column' in grep buffers.")
@@ -538,6 +567,8 @@ This function is called from `compilation-filter-hook'."
              (grep-use-null-device ,grep-use-null-device)
              (grep-find-command ,grep-find-command)
              (grep-find-template ,grep-find-template)
+             (grep-use-null-filename-separator
+              ,grep-use-null-filename-separator)
              (grep-find-use-xargs ,grep-find-use-xargs)
              (grep-highlight-matches ,grep-highlight-matches)))))
   (let* ((host-id
@@ -550,7 +581,8 @@ This function is called from `compilation-filter-hook'."
     ;; computed for every host once.
     (dolist (setting '(grep-command grep-template
                        grep-use-null-device grep-find-command
-                       grep-find-template grep-find-use-xargs
+                       grep-use-null-filename-separator
+                       grep-find-template grep-find-use-xargs
                        grep-highlight-matches))
       (set setting
            (cadr (or (assq setting host-defaults)
@@ -576,6 +608,21 @@ This function is called from `compilation-filter-hook'."
                          (concat (regexp-quote hello-file)
                                  ":[0-9]+:English")))))))))
 
+    (when (eq grep-use-null-filename-separator 'auto-detect)
+      (setq grep-use-null-filename-separator
+            (with-temp-buffer
+              (let* ((hello-file (expand-file-name "HELLO" data-directory))
+                     (args `("--null" "-ne" "^English" ,hello-file)))
+                (if grep-use-null-device
+                    (setq args (append args (list null-device)))
+                  (push "-H" args))
+                (and (grep-probe grep-program `(nil t nil ,@args))
+                     (progn
+                       (goto-char (point-min))
+                       (looking-at
+                        (concat (regexp-quote hello-file)
+                                "\0[0-9]+:English"))))))))
+
     (when (eq grep-highlight-matches 'auto-detect)
       (setq grep-highlight-matches
             (with-temp-buffer
@@ -591,6 +638,7 @@ This function is called from `compilation-filter-hook'."
                  grep-template grep-find-template)
       (let ((grep-options
              (concat (if grep-use-null-device "-n" "-nH")
+                     (if grep-use-null-filename-separator " --null")
                      (if (grep-probe grep-program
                                      `(nil nil nil "-e" "foo" ,null-device)
                                      nil 1)
@@ -733,7 +781,7 @@ This function is called from `compilation-filter-hook'."
   (set (make-local-variable 'compilation-error-face)
        grep-hit-face)
   (set (make-local-variable 'compilation-error-regexp-alist)
-       grep-regexp-alist)
+       (grep-regexp-alist))
   ;; compilation-directory-matcher can't be nil, so we set it to a regexp that
   ;; can never match.
   (set (make-local-variable 'compilation-directory-matcher) '("\\`a\\`"))
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index 389ddfca6b1..7a666e95297 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -85,10 +85,12 @@
     ;; 3.4.5 Other Linker Script Commands
     "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION"
     "INHIBIT_COMMON_ALLOCATION" "INSERT" "AFTER" "BEFORE"
-    "NOCROSSREFS" "OUTPUT_ARCH" "LD_FEATURE"
-    ;; 3.5.2 PROVIDE
+    "NOCROSSREFS" "NOCROSSREFS_TO" "OUTPUT_ARCH" "LD_FEATURE"
+    ;; 3.5.2 HIDDEN
+    "HIDDEN"
+    ;; 3.5.3 PROVIDE
     "PROVIDE"
-    ;; 3.5.3 PROVIDE_HIDDEN
+    ;; 3.5.4 PROVIDE_HIDDEN
     "PROVIDE_HIDDEN"
     ;; 3.6 SECTIONS Command
     "SECTIONS"
@@ -142,6 +144,7 @@
     "DEFINED"
     "LENGTH" "len" "l"
     "LOADADDR"
+    "LOG2CEIL"
     "MAX"
     "MIN"
     "NEXT"
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 3def37a2ea8..6197a53ee66 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -213,25 +213,6 @@
             (regexp-opt perl--syntax-exp-intro-keywords)
             "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
 
-;; FIXME: handle here-docs and regexps.
-;; <<EOF <<"EOF" <<'EOF' (no space)
-;; see `man perlop'
-;; ?...?
-;; /.../
-;; m [...]
-;; m /.../
-;; q /.../ = '...'
-;; qq /.../ = "..."
-;; qx /.../ = `...`
-;; qr /.../ = precompiled regexp =~=~ m/.../
-;; qw /.../
-;; s /.../.../
-;; s <...> /.../
-;; s '...'...'
-;; tr /.../.../
-;; y /.../.../
-;;
-;; <file*glob>
 (defun perl-syntax-propertize-function (start end)
   (let ((case-fold-search nil))
     (goto-char start)
@@ -324,23 +305,25 @@
       ((concat
         "\\(?:"
         ;; << "EOF", << 'EOF', or << \EOF
-        "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
+        "<<\\(~\\)?[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
         ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
         ;; disambiguate with the left-bitshift operator.
-        "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)"
+        "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
         ".*\\(\n\\)")
-       (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table))
-                 (name (match-string 1)))
-            (goto-char (match-end 1))
+       (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table))
+                 (name (match-string 2))
+                 (indented (match-beginning 1)))
+            (goto-char (match-end 2))
             (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))
-                            ((or `?\" `?\' `?\`) (substring name 1 -1))
-                            (_ name))
+                    (cons (cons (pcase (aref name 0)
+                                  (`?\\ (substring name 1))
+                                  ((or `?\" `?\' `?\`) (substring name 1 -1))
+                                  (_ name))
+                                indented)
                           (cdr st)))))))
       ;; We don't call perl-syntax-propertize-special-constructs directly
       ;; from the << rule, because there might be other elements (between
@@ -383,7 +366,9 @@
           (goto-char (nth 8 state)))
         (while (and names
                     (re-search-forward
-                     (concat "^" (regexp-quote (pop names)) "\n")
+                     (pcase-let ((`(,name . ,indented) (pop names)))
+                       (concat "^" (if indented "[ \t]*")
+                               (regexp-quote name) "\n"))
                      limit 'move))
           (unless names
             (put-text-property (1- (point)) (point) 'syntax-table
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b8ec50f14ae..cc9b794c5a0 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -917,20 +917,21 @@ IGNORES is a list of glob patterns."
   (grep-compute-defaults)
   (defvar grep-find-template)
   (defvar grep-highlight-matches)
-  (let* ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E"
-                                                       grep-find-template t t))
-         (grep-highlight-matches nil)
-         ;; TODO: Sanitize the regexp to remove Emacs-specific terms,
-         ;; so that Grep can search for the "relaxed" version.  Can we
-         ;; do that reliably enough, without creating false negatives?
-         (command (xref--rgrep-command (xref--regexp-to-extended regexp)
-                                       files
-                                       (expand-file-name dir)
-                                       ignores))
-         (buf (get-buffer-create " *xref-grep*"))
-         (grep-re (caar grep-regexp-alist))
-         status
-         hits)
+  (pcase-let*
+      ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E"
+                                                     grep-find-template t t))
+       (grep-highlight-matches nil)
+       ;; TODO: Sanitize the regexp to remove Emacs-specific terms,
+       ;; so that Grep can search for the "relaxed" version.  Can we
+       ;; do that reliably enough, without creating false negatives?
+       (command (xref--rgrep-command (xref--regexp-to-extended regexp)
+                                     files
+                                     (expand-file-name dir)
+                                     ignores))
+       (buf (get-buffer-create " *xref-grep*"))
+       (`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist)))
+       (status nil)
+       (hits nil))
     (with-current-buffer buf
       (erase-buffer)
       (setq status
@@ -944,8 +945,8 @@ IGNORES is a list of glob patterns."
                  (not (looking-at grep-re)))
         (user-error "Search failed with status %d: %s" status (buffer-string)))
       (while (re-search-forward grep-re nil t)
-        (push (list (string-to-number (match-string 2))
-                    (match-string 1)
+        (push (list (string-to-number (match-string line-group))
+                    (match-string file-group)
                     (buffer-substring-no-properties (point) (line-end-position)))
               hits)))
     (xref--convert-hits (nreverse hits) regexp)))