Merge from upstream, upto version 5.22.

After 5.0:
 `cperl-add-tags-recurse-noxs-fullpath': new function (for -batch mode)

After 5.1:
;; Major edit.  Summary of most visible changes:

;; a) Multiple <<HERE per line allowed.
;; b) Handles multiline subroutine declaration headers (with comments).
;;    (The exception is `cperl-etags' - but it is not used in the rest
;;    of the mode.)
;; c) Fontifies multiline my/our declarations (even with comments,
;;    and with legacy `font-lock').
;; d) Major speedup of syntaxification, both immediate and postponed
;;    (3.5x to 15x [for different CPUs and versions of Emacs] on the
;;    huge real-life document I tested).
;; e) New bindings, edits to imenu.
;; f) "_" is made into word-char during fontification/syntaxification;
;;    some attempts to recognize non-word "_" during other operations too.
;; g) Detect bug in Emacs with `looking-at' inside `narrow' and bulk out.
;; h) autoload some more perldoc-related stuff
;; i) Some new convenience features: ISpell POD/HEREDOCs, narrow-to-HEREDOC
;; j) Attempt to incorporate XEmacs edits which reached me

Fine-grained changelog:
`cperl-hook-after-change':	New configuration variable
`cperl-vc-sccs-header':	Likewise.
`cperl-vc-sccs-header':	Likewise.
`cperl-vc-header-alist':	Default via two preceding variables
`cperl-invalid-face':	Remove double quoting under XEmacs
				(still needed under 21.2)
`cperl-tips':		Update URLs for resources
`cperl-problems':		Likewise.
`cperl-praise':		Mention new features
New C-c key bindings:	for `cperl-find-bad-style',
`cperl-pod-spell', `cperl-here-doc-spell', `cperl-narrow-to-here-doc',
`cperl-perdoc', `cperl-perldoc-at-point'
CPerl Mode menu changes:	"Fix style by spaces", "Imenu on Perl Info"
moved, new submenu of Tools with Ispell entries and narrowing.
`cperl-after-sub-regexp':	New defsubst
`cperl-imenu--function-name-regexp-perl': Use `cperl-after-sub-regexp',
			Allows heads up to head4
			Allow "package;"
`defun-prompt-regexp':	Use `cperl-after-sub-regexp',
`paren-backwards-message':	??? Something for XEmacs???
`cperl-mode':		Never auto-switch abbrev-mode off
			Try to allow '_' be non-word char
			Do not use `font-lock-unfontify-region-function' on XEmacs
			Reset syntax cache on mode start
			Support multiline facification (even
			        on legacy `font-lock')
`cperl-facemenu-add-face-function':	??? Some contributed code ???
`cperl-after-change-function':	Since `font-lock' and `lazy-lock'
        refuse to inform us whether the fontification is due to lazy
        calling or due to edit to a buffer, install our own hook
        (controlled by `cperl-hook-after-change')
`cperl-electric-pod':	=cut may have been recognized as start
`cperl-block-p':		Moved, updated for attributes
`cperl-calculate-indent':	Try to allow '_' be non-word char
			Support subs with attributes
`cperl-where-am-i':		Queit (?) a warning
`cperl-cached-syntax-table'	New function
`cperl-forward-re':		Use `cperl-cached-syntax-table'
`cperl-unwind-to-safe':	Recognize `syntax-type' property
				changing in a middle of line
`cperl-find-sub-attrs':	New function
`cperl-find-pods-heres':	Allow many <<EOP per line
			Allow subs with attributes
			Major speedups (3.5x..15x on a real-life
			        test file nph-proxy.pl)
			Recognize "extproc " (OS/2)
			        case-folded and only at start
			/x on s///x with empty replacement was
			        not recognized
			Better comments
`cperl-after-block-p':	Remarks on diff with `cperl-block-p'
			Allow subs with attributes, labels
			Do not confuse "else::foo" with "else"
			Minor optimizations...
`cperl-after-expr-p':	Try to allow '_' be non-word char
`cperl-fill-paragraph':	Try to detect a major bug in Emacs
        with `looking-at' inside `narrow' and bulk out if found
`cperl-imenu--create-perl-index':	Updates for new
        `cperl-imenu--function-name-regexp-perl'
`cperl-outline-level':	Likewise.
`cperl-init-faces':		Allow multiline subroutine headers
        and my/our declarations, and ones with comments
			Allow subroutine attributes
`cperl-imenu-on-info':	Better docstring.
`cperl-etags'		Rudimentary support for attributes
			Support for packages and "package;"
`cperl-add-tags-recurse-noxs':	Better (?) docstring
`cperl-add-tags-recurse-noxs-fullpath': Likewise.
`cperl-tags-hier-init':	Misprint for `fboundp' fixed
`cperl-not-bad-style-regexp':	Try to allow '_' be non-word char
`cperl-perldoc':		Add autoload
`cperl-perldoc-at-point':	Likewise.
`cperl-here-doc-spell':	New function
`cperl-pod-spell':		Likewise.
`cperl-map-pods-heres':	Likewise.
`cperl-get-here-doc-region':	Likewise.
`cperl-font-lock-fontify-region-function': Likewise (backward compatibility
				        for legacy `font-lock')
`cperl-font-lock-unfontify-region-function': Fix style
`cperl-fontify-syntaxically':	Recognize and optimize away
        deferred calls with no-change.  Governed by `cperl-hook-after-change'
`cperl-fontify-update':	Recognize that syntaxification region
        can be larger than fontification one.
        XXXX we leave `cperl-postpone' property, so this is quadratic...
`cperl-fontify-update-bad':	Temporary placeholder until
        it is clear how to implement `cperl-fontify-update'.
`cperl-time-fontification':	New function
`attrib-group':		New text attribute
`multiline':		New value: `syntax-type' text attribute

After 5.2:
`cperl-emulate-lazy-lock':	New function
`cperl-fontify-syntaxically': Would skip large regions
Add `cperl-time-fontification', `cperl-emulate-lazy-lock' to menu
Some globals were declared, but uninitialized

After 5.3, 5.4:
`cperl-facemenu-add-face-function':	Add docs, fix U<>
Copyright message updated.
`cperl-init-faces':		Work around a bug in `font-lock'. May slow
				facification down a bit.
			Misprint for my|our|local for old `font-lock'
			"our" was not fontified same as "my|local"
			Highlight variables after "my" etc even in
				a middle of an expression
			Do not facify multiple variables after my etc
				unless parentheses are present

After 5.5, 5.6
`cperl-fontify-syntaxically': after-change hook could reset
`cperl-syntax-done-to' to a middle of line; unwind to BOL.

After 5.7:
`cperl-init-faces':		Allow highlighting of local ($/)
`cperl-problems-old-emaxen': New variable (for the purpose of DOCSTRING).
`cperl-problems':		Remove fixed problems.
`cperl-find-pods-heres':	Recognize #-comments in m##x too
			Recognize charclasses (unless delimiter is \).
`cperl-fontify-syntaxically': Unwinding to safe was done in wrong order
`cperl-regexp-scan':	Update docs
`cperl-beautify-regexp-piece': use information got from regexp scan

After 5.8:
Major user visible changes:
Recognition and fontification of character classes in RExen.
Variable indentation of RExen according to groups

`cperl-find-pods-heres':	Recognize POSIX classes in REx charclasses
			Fontify REx charclasses in variable-name face
			Fontify POSIX charclasses in "type" face
			Fontify unmatched "]" in function-name face
			Mark first-char of HERE-doc as `front-sticky'
			Reset `front-sticky' property when needed
`cperl-calculate-indent':	Indents //x -RExen accordning to parens level
`cperl-to-comment-or-eol':	Recognize ends of `syntax-type' constructs
`cperl-backward-to-noncomment': Recognize stringy `syntax-type' constructs
			Support `narrow'ed buffers.
`cperl-praise':		Remove a reservation
`cperl-make-indent':	New function
`cperl-indent-for-comment':	Use `cperl-make-indent'
`cperl-indent-line':	Likewise.
`cperl-lineup':		Likewise.
`cperl-beautify-regexp-piece': Likewise.
`cperl-contract-level':	Likewise.
`cperl-toggle-set-debug-unwind': New function
			New menu entry for this
`fill-paragraph-function':	Use when `boundp'
`cperl-calculate-indent':	Take into account groups when indenting RExen
`cperl-to-comment-or-eol':	Recognize # which end a string
`cperl-modify-syntax-type':	Make only syntax-table property non-sticky
`cperl-fill-paragraph':	Return t: needed for `fill-paragraph-function'
`cperl-fontify-syntaxically': More clear debugging message
`cperl-pod2man-build-command': XEmacs portability: check `Man-filter-list'
`cperl-init-faces':		More complicated highlight even on XEmacs (new)
Merge cosmetic changes from XEmacs

After 5.9:
`cperl-1+':			Moved to before the first use
`cperl-1-':			Likewise.

After 5.10:

This code may lock Emacs hard!!!  Use on your own risk!

`cperl-font-locking':	New internal variable
`cperl-beginning-of-property': New function
`cperl-calculate-indent':	Use `cperl-beginning-of-property'
instead of `previous-single-property-change'
`cperl-unwind-to-safe':	Likewise.
`cperl-after-expr-p':	Likewise.
`cperl-get-here-doc-region': Likewise.
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-to-comment-or-eol':	Do not call `cperl-update-syntaxification'
				recursively
			Bound `next-single-property-change'
				via `point-max'
`cperl-unwind-to-safe':	Bound likewise
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-find-pods-heres':	Mark as recursive for `cperl-to-comment-or-eol'
			Initialization of
`cperl-font-lock-multiline-start' could be missed if the "main"
fontification did not run due to the keyword being already fontified.
`cperl-pod-spell':		Return t from do-one-chunk function
`cperl-map-pods-heres':	Stop when the worker returns nil
			Call `cperl-update-syntaxification'
`cperl-get-here-doc-region': Call `cperl-update-syntaxification'
`cperl-get-here-doc-delim':	Remove unused function

After 5.11:

 The possible lockup of Emacs (introduced in 5.10) fixed

`cperl-unwind-to-safe':	`cperl-beginning-of-property' won't return nil
`cperl-syntaxify-for-menu':	New customization variable
`cperl-select-this-pod-or-here-doc': New function
`cperl-get-here-doc-region': Extra argument
			Do not adjust pos by 1

New menu entries (Perl/Tools): Selection of current POD or HERE-DOC section
			(Debugging CPerl:) backtrace on fontification

After 5.12:
`cperl-cached-syntax-table': use `car-safe'
`cperl-forward-re':		Remove spurious argument SET-ST
			Add documentation
`cperl-forward-group-in-re': New function
`cperl-find-pods-heres':	Find and highlight (?{}) blocks in RExen
(XXXX Temporary (?) hack is to syntax-mark them as comment)

After 5.13:
`cperl-string-syntax-table': Make { and } not-grouping
  (Sometimes they ARE grouping in RExen, but matching them would only
   confuse in many situations when they are not)
`beginning-of-buffer':	Replaced two occurences with goto-char...
`cperl-calculate-indent':	`char-after' could be nil...
`cperl-find-pods-heres':	REx can start after "[" too
			Hightlight (??{}) in RExen too
`cperl-maybe-white-and-comment-rex': New constant
`cperl-white-and-comment-rex': Likewise.
			XXXX Not very efficient, but hard to make
			better while keeping 1 group

After 5.13:
`cperl-find-pods-heres':	$foo << identifier() is not a HERE-DOC
			Likewise for 1 << identifier

After 5.14:
`cperl-find-pods-heres':	Different logic for $foo .= <<EOF etc
			Error-less condition-case could fail
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-init-faces':		Likewise.

After 5.15:
`cperl-find-pods-heres':	Support property REx-part2
`cperl-calculate-indent':	Likewise.
			Don't special-case REx with non-empty 1st line
`cperl-find-pods-heres':	In RExen, highlight non-literal backslashes
			Invert highlighting of charclasses:
				now the envelop is highlighted
			Highlight many others 0-length builtins
`cperl-praise':		Mention indenting and highlight in RExen

After 5.15:
`cperl-find-pods-heres':	Highlight capturing parens in REx

After 5.16:
`cperl-find-pods-heres':	Highlight '|' for alternation
Initialize `font-lock-warning-face' if not present
`cperl-find-pods-heres':	Use `font-lock-warning-face' instead of
				 `font-lock-function-name-face'
`cperl-look-at-leading-count': Likewise.
`cperl-find-pods-heres':	localize `font-lock-variable-name-face'
				`font-lock-keyword-face' (needed for
				batch processing) etc
			Use `font-lock-builtin-face' for builtin in REx
				Now `font-lock-variable-name-face'
				is used for interpolated variables
			Use "talking aliases" for faces inside REx
			Highlight parts of REx (except in charclasses)
				according to the syntax and/or semantic
			Syntax-mark a {}-part of (?{}) as "comment"
				(it was the ()-part)
			Better logic to distinguish what is what in REx
`cperl-tips-faces':		Document REx highlighting
`cperl-praise':		Mention REx syntax highlight etc.

After 5.17:
`cperl-find-sub-attrs':	Would not always manage to print error message
`cperl-find-pods-heres':	localize `font-lock-constant-face'

After 5.18:
`cperl-find-pods-heres':	Misprint in REx for parsing REx
			Very minor optimization
			`my-cperl-REx-modifiers-face' got quoted
			Recognize "print $foo <<END" as HERE-doc
			Put `REx-interpolated' text attribute if needed
`cperl-invert-if-unless-modifiers':	New function
`cperl-backward-to-start-of-expr': Likewise.
`cperl-forward-to-end-of-expr': Likewise.
`cperl-invert-if-unless':	Works in "the opposite way" too
			Cursor position on return is on the switch-word
			Indents comments better
`REx-interpolated':		New text attribute
`cperl-next-interpolated-REx': New function
`cperl-next-interpolated-REx-0': Likewise.
`cperl-next-interpolated-REx-1': Likewise.
"\C-c\C-x", "\C-c\C-y", "\C-c\C-v":	New keybinding for these functions
Perl/Regexp menu:		3 new entries for `cperl-next-interpolated-REx'
`cperl-praise':		Mention finded interpolated RExen

After 5.19:
`cperl-init-faces':		Highlight %$foo, @$foo too
`cperl-short-docs':		Better docs for system, exec
`cperl-find-pods-heres':	Better detect << after print {FH} <<EOF etc.
			Would not find HERE-doc ended by EOF without NL
`cperl-short-docs':		Correct not-doubled \-escapes
start block:		Put some `defvar' for stuff gone from XEmacs

After 5.20:
initial comment:		Extend copyright, fix email address
`cperl-indent-comment-at-column-0': New customization variable
`cperl-comment-indent':	Indentation after $#a would increasy by 1
`cperl-mode':		Make `defun-prompt-regexp' grok BEGIN/END etc
`cperl-find-pods-heres':	Mark CODE of s///e as `syntax-type' `multiline'
`cperl-at-end-of-expr':	Would fail if @BAR=12 follows after ";"
`cperl-init-faces':		If `cperl-highlight-variables-indiscriminately'
				highlight $ in $foo too (UNTESTED)
`cperl-set-style':		Docstring missed some available styles
toplevel:			Menubar/Perl/Indent-Styles had FSF, now K&R
			Change "Current" to "Memorize Current"
`cperl-indent-wrt-brace':	New customization variable; the default is
			as for pre-5.2 version
`cperl-styles-entries':	Keep `cperl-extra-newline-before-brace-multiline'
`cperl-style-alist':	Likewise.
`cperl-fix-line-spacing':	Support `cperl-merge-trailing-else' being nil,
			and `cperl-extra-newline-before-brace' etc
			being t
`cperl-indent-exp':		Plans B and C to find continuation blocks even
			if `cperl-extra-newline-before-brace' is t

After 5.21:
Improve some docstrings concerning indentation.
`cperl-indent-rules-alist':	New variable
`cperl-sniff-for-indent':	New function name
			(separated from `cperl-calculate-indent')
`cperl-calculate-indent':	Separated the sniffer and the indenter;
			uses `cperl-sniff-for-indent' now
`cperl-comment-indent':	Test for `cperl-indent-comment-at-column-0'
			was inverted;
			Support `comment-column' = 0

1 files changed, 2947 insertions, 1185 deletions

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 69f4549a0bf..3264e0e72f6 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -5,7 +5,7 @@
 ;;     Free Software Foundation, Inc.
 
 ;; Author: Ilya Zakharevich and Bob Olson
-;; Maintainer: Ilya Zakharevich <cperl@ilyaz.org>
+;; Maintainer: Ilya Zakharevich <ilyaz@cpan.org>
 ;; Keywords: languages, Perl
 
 ;; This file is part of GNU Emacs.
@@ -25,7 +25,7 @@
 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;; Boston, MA 02110-1301, USA.
 
-;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org
+;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org
 
 ;;; Commentary:
 
@@ -67,67 +67,89 @@
 ;; likewise with m, tr, y, q, qX instead of s
 
 ;;; Code:
-
+
 (defvar vc-rcs-header)
 (defvar vc-sccs-header)
 
-;; Some macros are needed for `defcustom'
 (eval-when-compile
-  (condition-case nil
-      (require 'man)
-    (error nil))
-  (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
-  (defvar cperl-can-font-lock
-    (or cperl-xemacs-p
-        (and (boundp 'emacs-major-version)
-                (or window-system
-                    (> emacs-major-version 20)))))
-  (if cperl-can-font-lock
-      (require 'font-lock))
-  (defvar msb-menu-cond)
-  (defvar gud-perldb-history)
-  (defvar font-lock-background-mode)    ; not in Emacs
-  (defvar font-lock-display-type)       ; ditto
-  (defmacro cperl-is-face (arg)         ; Takes quoted arg
-    (cond ((fboundp 'find-face)
-           `(find-face ,arg))
-          (;;(and (fboundp 'face-list)
-           ;;   (face-list))
-           (fboundp 'face-list)
-           `(member ,arg (and (fboundp 'face-list)
-                              (face-list))))
-          (t
-           `(boundp ,arg))))
-  (defmacro cperl-make-face (arg descr) ; Takes unquoted arg
-    (cond ((fboundp 'make-face)
-           `(make-face (quote ,arg)))
-          (t
-           `(defvar ,arg (quote ,arg) ,descr))))
-  (defmacro cperl-force-face (arg descr) ; Takes unquoted arg
-    `(progn
-       (or (cperl-is-face (quote ,arg))
-           (cperl-make-face ,arg ,descr))
-       (or (boundp (quote ,arg))        ; We use unquoted variants too
-           (defvar ,arg (quote ,arg) ,descr))))
-  (if cperl-xemacs-p
-      (defmacro cperl-etags-snarf-tag (file line)
-        `(progn
-           (beginning-of-line 2)
-           (list ,file ,line)))
-    (defmacro cperl-etags-snarf-tag (file line)
-      `(etags-snarf-tag)))
-  (if cperl-xemacs-p
-      (defmacro cperl-etags-goto-tag-location (elt)
-        ;;(progn
-        ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0)))
-        ;; (set-buffer (get-file-buffer (elt (, elt) 0)))
-        ;; Probably will not work due to some save-excursion???
-        ;; Or save-file-position?
-        ;; (message "Did I get to line %s?" (elt (, elt) 1))
-        `(goto-line (string-to-number (elt ,elt 1))))
-    ;;)
-    (defmacro cperl-etags-goto-tag-location (elt)
-      `(etags-goto-tag-location ,elt))))
+      (condition-case nil
+          (require 'custom)
+        (error nil))
+      (condition-case nil
+          (require 'man)
+        (error nil))
+      (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+      (defvar cperl-can-font-lock
+        (or cperl-xemacs-p
+            (and (boundp 'emacs-major-version)
+                 (or window-system
+                     (> emacs-major-version 20)))))
+      (if cperl-can-font-lock
+          (require 'font-lock))
+      (defvar msb-menu-cond)
+      (defvar gud-perldb-history)
+      (defvar font-lock-background-mode) ; not in Emacs
+      (defvar font-lock-display-type)   ; ditto
+      (defvar paren-backwards-message)  ; Not in newer XEmacs?
+      (or (fboundp 'defgroup)
+          (defmacro defgroup (name val doc &rest arr)
+            nil))
+      (or (fboundp 'custom-declare-variable)
+          (defmacro defcustom (name val doc &rest arr)
+            (` (defvar (, name) (, val) (, doc)))))
+      (or (and (fboundp 'custom-declare-variable)
+               (string< "19.31" emacs-version)) ;  Checked with 19.30: defface does not work
+          (defmacro defface (&rest arr)
+            nil))
+      ;; Avoid warning (tmp definitions)
+      (or (fboundp 'x-color-defined-p)
+          (defmacro x-color-defined-p (col)
+            (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col))))
+                  ;; XEmacs >= 19.12
+                  ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col))))
+                  ;; XEmacs 19.11
+                  ((fboundp 'x-valid-color-name-p) (` (x-valid-color-name-p (, col))))
+                  (t '(error "Cannot implement color-defined-p")))))
+      (defmacro cperl-is-face (arg)     ; Takes quoted arg
+        (cond ((fboundp 'find-face)
+               (` (find-face (, arg))))
+              (;;(and (fboundp 'face-list)
+               ;;       (face-list))
+               (fboundp 'face-list)
+               (` (member (, arg) (and (fboundp 'face-list)
+                                       (face-list)))))
+              (t
+               (` (boundp (, arg))))))
+      (defmacro cperl-make-face (arg descr) ; Takes unquoted arg
+        (cond ((fboundp 'make-face)
+               (` (make-face (quote (, arg)))))
+              (t
+               (` (defvar (, arg) (quote (, arg)) (, descr))))))
+      (defmacro cperl-force-face (arg descr) ; Takes unquoted arg
+        (` (progn
+             (or (cperl-is-face (quote (, arg)))
+                 (cperl-make-face (, arg) (, descr)))
+             (or (boundp (quote (, arg))) ; We use unquoted variants too
+                 (defvar (, arg) (quote (, arg)) (, descr))))))
+      (if cperl-xemacs-p
+          (defmacro cperl-etags-snarf-tag (file line)
+            (` (progn
+                 (beginning-of-line 2)
+                 (list (, file) (, line)))))
+        (defmacro cperl-etags-snarf-tag (file line)
+          (` (etags-snarf-tag))))
+      (if cperl-xemacs-p
+          (defmacro cperl-etags-goto-tag-location (elt)
+            (`;;(progn
+             ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0)))
+             ;; (set-buffer (get-file-buffer (elt (, elt) 0)))
+             ;; Probably will not work due to some save-excursion???
+             ;; Or save-file-position?
+             ;; (message "Did I get to line %s?" (elt (, elt) 1))
+             (goto-line (string-to-int (elt (, elt) 1)))))
+        ;;)
+        (defmacro cperl-etags-goto-tag-location (elt)
+          (` (etags-goto-tag-location (, elt))))))
 
 (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
 
@@ -251,6 +273,12 @@ This is in addition to cperl-continued-statement-offset."
   :type 'integer
   :group 'cperl-indentation-details)
 
+(defcustom cperl-indent-wrt-brace t
+  "*Non-nil means indent statements in if/etc block relative brace, not if/etc.
+Versions 5.2 ... 5.20 behaved as if this were `nil'."
+  :type 'boolean
+  :group 'cperl-indentation-details)
+
 (defcustom cperl-auto-newline nil
   "*Non-nil means automatically newline before and after braces,
 and after colons and semicolons, inserted in CPerl code.  The following
@@ -347,20 +375,26 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
   :type 'integer
   :group 'cperl-indentation-details)
 
-(defvar cperl-vc-header-alist nil)
-(make-obsolete-variable
- 'cperl-vc-header-alist
- "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.")
+(defcustom cperl-indent-comment-at-column-0 nil
+  "*Non-nil means that comment started at column 0 should be indentable."
+  :type 'boolean
+  :group 'cperl-indentation-details)
 
 (defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
   "*Special version of `vc-sccs-header' that is used in CPerl mode buffers."
   :type '(repeat string)
   :group 'cperl)
 
-(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")
+(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/);")
   "*Special version of `vc-rcs-header' that is used in CPerl mode buffers."
   :type '(repeat string)
-  :group 'cperl)
+     :group 'cperl)
+
+;; This became obsolete...
+(defvar cperl-vc-header-alist nil)
+(make-obsolete-variable
+ 'cperl-vc-header-alist
+ "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.")
 
 (defcustom cperl-clobber-mode-lists
   (not
@@ -408,8 +442,15 @@ Font for POD headers."
   :type 'face
   :group 'cperl-faces)
 
-(defcustom cperl-invalid-face 'underline
-  "*Face for highlighting trailing whitespace."
+;;; Some double-evaluation happened with font-locks...  Needed with 21.2...
+(defvar cperl-singly-quote-face cperl-xemacs-p)
+
+(defcustom cperl-invalid-face           ; Does not customize with '' on XEmacs
+  (if cperl-singly-quote-face
+      'underline ''underline) ; On older Emacsen was evaluated by `font-lock'
+  (if cperl-singly-quote-face
+      "*This face is used for highlighting trailing whitespace."
+    "*Face for highlighting trailing whitespace.")
   :type 'face
   :version "21.1"
   :group 'cperl-faces)
@@ -441,7 +482,14 @@ You can always make lookup from menu or using \\[cperl-find-pods-heres]."
 
 (defcustom cperl-regexp-scan t
   "*Not-nil means make marking of regular expression more thorough.
-Effective only with `cperl-pod-here-scan'.  Not implemented yet."
+Effective only with `cperl-pod-here-scan'."
+  :type 'boolean
+  :group 'cperl-speed)
+
+(defcustom cperl-hook-after-change t
+  "*Not-nil means install hook to know which regions of buffer are changed.
+May significantly speed up delayed fontification.  Changes take effect
+after reload."
   :type 'boolean
   :group 'cperl-speed)
 
@@ -564,17 +612,25 @@ when syntaxifying a chunk of buffer."
   :type 'boolean
   :group 'cperl-speed)
 
+(defcustom cperl-syntaxify-for-menu
+  t
+  "*Non-nil means that CPerl syntaxifies up to the point before showing menu.
+This way enabling/disabling of menu items is more correct."
+  :type 'boolean
+  :group 'cperl-speed)
+
 (defcustom cperl-ps-print-face-properties
   '((font-lock-keyword-face             nil nil         bold shadow)
     (font-lock-variable-name-face       nil nil         bold)
     (font-lock-function-name-face       nil nil         bold italic box)
     (font-lock-constant-face            nil "LightGray" bold)
-    (cperl-array                        nil "LightGray" bold underline)
-    (cperl-hash                         nil "LightGray" bold italic underline)
+    (cperl-array-face                   nil "LightGray" bold underline)
+    (cperl-hash-face                            nil "LightGray" bold italic underline)
     (font-lock-comment-face             nil "LightGray" italic)
     (font-lock-string-face              nil nil         italic underline)
-    (cperl-nonoverridable               nil nil         italic underline)
+    (cperl-nonoverridable-face          nil nil         italic underline)
     (font-lock-type-face                nil nil         underline)
+    (font-lock-warning-face             nil "LightGray" bold italic box)
     (underline                          nil "LightGray" strikeout))
   "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
   :type '(repeat (cons symbol
@@ -588,7 +644,7 @@ when syntaxifying a chunk of buffer."
 (defvar cperl-dark-foreground
   (cperl-choose-color "orchid1" "orange"))
 
-(defface cperl-nonoverridable
+(defface cperl-nonoverridable-face
   `((((class grayscale) (background light))
      (:background "Gray90" :slant italic :underline t))
     (((class grayscale) (background dark))
@@ -600,10 +656,8 @@ when syntaxifying a chunk of buffer."
     (t (:weight bold :underline t)))
   "Font Lock mode face used non-overridable keywords and modifiers of regexps."
   :group 'cperl-faces)
-;; backward-compatibility alias
-(put 'cperl-nonoverridable-face 'face-alias 'cperl-nonoverridable)
 
-(defface cperl-array
+(defface cperl-array-face
   `((((class grayscale) (background light))
      (:background "Gray90" :weight bold))
     (((class grayscale) (background dark))
@@ -615,10 +669,8 @@ when syntaxifying a chunk of buffer."
     (t (:weight bold)))
   "Font Lock mode face used to highlight array names."
   :group 'cperl-faces)
-;; backward-compatibility alias
-(put 'cperl-array-face 'face-alias 'cperl-array)
 
-(defface cperl-hash
+(defface cperl-hash-face
   `((((class grayscale) (background light))
      (:background "Gray90" :weight bold :slant italic))
     (((class grayscale) (background dark))
@@ -630,8 +682,6 @@ when syntaxifying a chunk of buffer."
     (t (:weight bold :slant italic)))
   "Font Lock mode face used to highlight hash names."
   :group 'cperl-faces)
-;; backward-compatibility alias
-(put 'cperl-hash-face 'face-alias 'cperl-hash)
 
 
 
@@ -639,9 +689,7 @@ when syntaxifying a chunk of buffer."
 
 (defvar cperl-tips 'please-ignore-this-line
   "Get maybe newer version of this package from
-  ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
-and/or
-  ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
+  http://ilyaz.org/software/emacs
 Subdirectory `cperl-mode' may contain yet newer development releases and/or
 patches to related files.
 
@@ -666,9 +714,9 @@ want it to: put the following into your .emacs file:
   (defalias 'perl-mode 'cperl-mode)
 
 Get perl5-info from
-  $CPAN/doc/manual/info/perl-info.tar.gz
-older version was on
-  http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz
+  $CPAN/doc/manual/info/perl5-old/perl5-info.tar.gz
+Also, one can generate a newer documentation running `pod2texi' converter
+  $CPAN/doc/manual/info/perl5/pod2texi-0.1.tar.gz
 
 If you use imenu-go, run imenu on perl5-info buffer (you can do it
 from Perl menu).  If many files are related, generate TAGS files from
@@ -700,11 +748,18 @@ micro-docs on what I know about CPerl problems.")
   "Description of problems in CPerl mode.
 Some faces will not be shown on some versions of Emacs unless you
 install choose-color.el, available from
-   ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/
+  http://ilyaz.org/software/emacs
 
 `fill-paragraph' on a comment may leave the point behind the
-paragraph.  Parsing of lines with several <<EOF is not implemented
-yet.
+paragraph.  It also triggers a bug in some versions of Emacs (CPerl tries
+to detect it and bulk out).
+
+See documentation of a variable `cperl-problems-old-emaxen' for the
+problems which disappear if you upgrade Emacs to a reasonably new
+version (20.3 for Emacs, and those of 2004 for XEmacs).")
+
+(defvar cperl-problems-old-emaxen 'please-ignore-this-line
+  "Description of problems in CPerl mode specific for older Emacs versions.
 
 Emacs had a _very_ restricted syntax parsing engine until version
 20.1.  Most problems below are corrected starting from this version of
@@ -812,6 +867,13 @@ voice);
         o) Highlights trailing whitespace;
         p) Is able to manipulate Perl Regular Expressions to ease
            conversion to a more readable form.
+        q) Can ispell POD sections and HERE-DOCs.
+        r) Understands comments and character classes inside regular
+           expressions; can find matching () and [] in a regular expression.
+        s) Allows indentation of //x-style regular expressions;
+        t) Highlights different symbols in regular expressions according
+           to their function; much less problems with backslashitis;
+        u) Allows to find regular expressions which contain interpolated parts.
 
 5) The indentation engine was very smart, but most of tricks may be
 not needed anymore with the support for `syntax-table' property.  Has
@@ -829,7 +891,10 @@ the settings present before the switch.
 line-breaks/spacing between elements of the construct.
 
 10) Uses a linear-time algorith for indentation of regions (on Emaxen with
-capable syntax engines).")
+capable syntax engines).
+
+11) Syntax-highlight, indentation, sexp-recognition inside regular expressions.
+")
 
 (defvar cperl-speed 'please-ignore-this-line
   "This is an incomplete compendium of what is available in other parts
@@ -878,19 +943,19 @@ B) Speed of editing operations.
 (defvar cperl-tips-faces 'please-ignore-this-line
   "CPerl mode uses following faces for highlighting:
 
-  `cperl-array'                 Array names
-  `cperl-hash'                  Hash names
+  `cperl-array-face'                    Array names
+  `cperl-hash-face'                     Hash names
   `font-lock-comment-face'      Comments, PODs and whatever is considered
                                 syntaxically to be not code
   `font-lock-constant-face'     HERE-doc delimiters, labels, delimiters of
                                 2-arg operators s/y/tr/ or of RExen,
-  `font-lock-function-name-face' Special-cased m// and s//foo/, _ as
-                                a target of a file tests, file tests,
+  `font-lock-warning-face'      Special-cased m// and s//foo/,
+  `font-lock-function-name-face' _ as a target of a file tests, file tests,
                                 subroutine names at the moment of definition
                                 (except those conflicting with Perl operators),
                                 package names (when recognized), format names
   `font-lock-keyword-face'      Control flow switch constructs, declarators
-  `cperl-nonoverridable'        Non-overridable keywords, modifiers of RExen
+  `cperl-nonoverridable-face'   Non-overridable keywords, modifiers of RExen
   `font-lock-string-face'       Strings, qw() constructs, RExen, POD sections,
                                 literal parts and the terminator of formats
                                 and whatever is syntaxically considered
@@ -908,7 +973,25 @@ m// and s/// which do not do what one would expect them to do.
 Help with best setup of these faces for printout requested (for each of
 the faces: please specify bold, italic, underline, shadow and box.)
 
-\(Not finished.)")
+In regular expressions (except character classes):
+  `font-lock-string-face'       \"Normal\" stuff and non-0-length constructs
+  `font-lock-constant-face':    Delimiters
+  `font-lock-warning-face'      Special-cased m// and s//foo/,
+                                Mismatched closing delimiters, parens
+                                we couldn't match, misplaced quantifiers,
+                                unrecognized escape sequences
+  `cperl-nonoverridable-face'   Modifiers, as gism in m/REx/gism
+  `font-lock-type-face'         POSIX classes inside charclasses,
+                                escape sequences with arguments (\x \23 \p \N)
+                                and others match-a-char escape sequences
+  `font-lock-keyword-face'      Capturing parens, and |
+  `font-lock-function-name-face' Special symbols: $ ^ . [ ] [^ ] (?{ }) (??{ })
+  `font-lock-builtin-face'      \"Remaining\" 0-length constructs, executable
+                                parts of a REx, not-capturing parens
+  `font-lock-variable-name-face' Interpolated constructs, embedded code
+  `font-lock-comment-face'      Embedded comments
+
+")
 
 
 
@@ -985,6 +1068,25 @@ the faces: please specify bold, italic, underline, shadow and box.)
    (cperl-hairy (or hairy t))
    (t (symbol-value symbol))))
 
+
+(defun cperl-make-indent (column &optional minimum keep)
+  "Makes indent of the current line the requested amount.
+Unless KEEP, removes the old indentation.  Works around a bug in ancient
+versions of Emacs."
+  (let ((prop (get-text-property (point) 'syntax-type)))
+    (or keep
+        (delete-horizontal-space))
+    (indent-to column minimum)
+    ;; In old versions (e.g., 19.33) `indent-to' would not inherit properties
+    (and prop
+         (> (current-column) 0)
+         (save-excursion
+           (beginning-of-line)
+           (or (get-text-property (point) 'syntax-type)
+               (and (looking-at "\\=[ \t]")
+                      (put-text-property (point) (match-end 0)
+                                         'syntax-type prop)))))))
+
 ;;; Probably it is too late to set these guys already, but it can help later:
 
 ;;;(and cperl-clobber-mode-lists
@@ -1035,7 +1137,16 @@ the faces: please specify bold, italic, underline, shadow and box.)
   (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix)
   (cperl-define-key "\C-c\C-f" 'auto-fill-mode)
   (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
+  (cperl-define-key "\C-c\C-b" 'cperl-find-bad-style)
+  (cperl-define-key "\C-c\C-p" 'cperl-pod-spell)
+  (cperl-define-key "\C-c\C-d" 'cperl-here-doc-spell)
+  (cperl-define-key "\C-c\C-n" 'cperl-narrow-to-here-doc)
+  (cperl-define-key "\C-c\C-v" 'cperl-next-interpolated-REx)
+  (cperl-define-key "\C-c\C-x" 'cperl-next-interpolated-REx-0)
+  (cperl-define-key "\C-c\C-y" 'cperl-next-interpolated-REx-1)
   (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp)
+  (cperl-define-key "\C-c\C-hp" 'cperl-perldoc)
+  (cperl-define-key "\C-c\C-hP" 'cperl-perldoc-at-point)
   (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
   (cperl-define-key [?\C-\M-\|] 'cperl-lineup
                     [(control meta |)])
@@ -1074,9 +1185,13 @@ the faces: please specify bold, italic, underline, shadow and box.)
            (<= emacs-minor-version 11) (<= emacs-major-version 19))
       (progn
         ;; substitute-key-definition is usefulness-deenhanced...
-        (cperl-define-key "\M-q" 'cperl-fill-paragraph)
+        ;;;;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
         (cperl-define-key "\e;" 'cperl-indent-for-comment)
         (cperl-define-key "\e\C-\\" 'cperl-indent-region))
+    (or (boundp 'fill-paragraph-function)
+        (substitute-key-definition
+         'fill-paragraph 'cperl-fill-paragraph
+         cperl-mode-map global-map))
     (substitute-key-definition
      'indent-sexp 'cperl-indent-exp
      cperl-mode-map global-map)
@@ -1094,52 +1209,101 @@ the faces: please specify bold, italic, underline, shadow and box.)
     (progn
       (require 'easymenu)
       (easy-menu-define
-        cperl-menu cperl-mode-map "Menu for CPerl mode"
-        '("Perl"
-          ["Beginning of function" beginning-of-defun t]
-          ["End of function" end-of-defun t]
-          ["Mark function" mark-defun t]
-          ["Indent expression" cperl-indent-exp t]
+       cperl-menu cperl-mode-map "Menu for CPerl mode"
+       '("Perl"
+         ["Beginning of function" beginning-of-defun t]
+         ["End of function" end-of-defun t]
+         ["Mark function" mark-defun t]
+         ["Indent expression" cperl-indent-exp t]
           ["Fill paragraph/comment" fill-paragraph t]
+         "----"
+         ["Line up a construction" cperl-lineup (cperl-use-region-p)]
+         ["Invert if/unless/while etc" cperl-invert-if-unless t]
+         ("Regexp"
+          ["Beautify" cperl-beautify-regexp
+           cperl-use-syntax-table-text-property]
+          ["Beautify one level deep" (cperl-beautify-regexp 1)
+           cperl-use-syntax-table-text-property]
+          ["Beautify a group" cperl-beautify-level
+           cperl-use-syntax-table-text-property]
+          ["Beautify a group one level deep" (cperl-beautify-level 1)
+           cperl-use-syntax-table-text-property]
+          ["Contract a group" cperl-contract-level
+           cperl-use-syntax-table-text-property]
+          ["Contract groups" cperl-contract-levels
+           cperl-use-syntax-table-text-property]
           "----"
-          ["Line up a construction" cperl-lineup (cperl-use-region-p)]
-          ["Invert if/unless/while etc" cperl-invert-if-unless t]
-          ("Regexp"
-           ["Beautify" cperl-beautify-regexp
-            cperl-use-syntax-table-text-property]
-           ["Beautify one level deep" (cperl-beautify-regexp 1)
-            cperl-use-syntax-table-text-property]
-           ["Beautify a group" cperl-beautify-level
-            cperl-use-syntax-table-text-property]
-           ["Beautify a group one level deep" (cperl-beautify-level 1)
-            cperl-use-syntax-table-text-property]
-           ["Contract a group" cperl-contract-level
-            cperl-use-syntax-table-text-property]
-           ["Contract groups" cperl-contract-levels
-            cperl-use-syntax-table-text-property])
-          ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
+          ["Find next interpolated" cperl-next-interpolated-REx 
+           (next-single-property-change (point-min) 'REx-interpolated)]
+          ["Find next interpolated (no //o)"
+           cperl-next-interpolated-REx-0
+           (or (text-property-any (point-min) (point-max) 'REx-interpolated t)
+               (text-property-any (point-min) (point-max) 'REx-interpolated 1))]
+          ["Find next interpolated (neither //o nor whole-REx)"
+           cperl-next-interpolated-REx-1
+           (text-property-any (point-min) (point-max) 'REx-interpolated t)])
+         ["Insert spaces if needed to fix style" cperl-find-bad-style t]
+         ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
+         "----"
+         ["Indent region" cperl-indent-region (cperl-use-region-p)]
+         ["Comment region" cperl-comment-region (cperl-use-region-p)]
+         ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)]
+         "----"
+         ["Run" mode-compile (fboundp 'mode-compile)]
+         ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
+                                        (get-buffer "*compilation*"))]
+         ["Next error" next-error (get-buffer "*compilation*")]
+         ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
+         "----"
+         ["Debugger" cperl-db t]
+         "----"
+         ("Tools"
+          ["Imenu" imenu (fboundp 'imenu)]
+          ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)]
           "----"
-          ["Indent region" cperl-indent-region (cperl-use-region-p)]
-          ["Comment region" cperl-comment-region (cperl-use-region-p)]
-          ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)]
+          ["Ispell PODs" cperl-pod-spell
+           ;; Better not to update syntaxification here:
+           ;; debugging syntaxificatio can be broken by this???
+           (or
+            (get-text-property (point-min) 'in-pod)
+            (< (progn
+                 (and cperl-syntaxify-for-menu
+                      (cperl-update-syntaxification (point-max) (point-max)))
+                 (next-single-property-change (point-min) 'in-pod nil (point-max)))
+               (point-max)))]
+          ["Ispell HERE-DOCs" cperl-here-doc-spell
+           (< (progn
+                (and cperl-syntaxify-for-menu
+                     (cperl-update-syntaxification (point-max) (point-max)))
+                (next-single-property-change (point-min) 'here-doc-group nil (point-max)))
+              (point-max))]
+          ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc
+           (eq 'here-doc  (progn
+                (and cperl-syntaxify-for-menu
+                     (cperl-update-syntaxification (point) (point)))
+                (get-text-property (point) 'syntax-type)))]
+          ["Select this HERE-DOC or POD section"
+           cperl-select-this-pod-or-here-doc
+           (memq (progn
+                   (and cperl-syntaxify-for-menu
+                        (cperl-update-syntaxification (point) (point)))
+                   (get-text-property (point) 'syntax-type))
+                 '(here-doc pod))]
           "----"
-          ["Run" mode-compile (fboundp 'mode-compile)]
-          ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
-                                         (get-buffer "*compilation*"))]
-          ["Next error" next-error (get-buffer "*compilation*")]
-          ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
+          ["CPerl pretty print (exprmntl)" cperl-ps-print
+           (fboundp 'ps-extend-face-list)]
           "----"
-          ["Debugger" cperl-db t]
+          ["Syntaxify region" cperl-find-pods-heres-region
+           (cperl-use-region-p)]
+          ["Profile syntaxification" cperl-time-fontification t]
+          ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t]
+          ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t]
+          ["Debug backtrace on syntactic scan (BEWARE!!!)"
+           (cperl-toggle-set-debug-unwind nil t) t]
           "----"
-          ("Tools"
-           ["Imenu" imenu (fboundp 'imenu)]
-           ["Insert spaces if needed" cperl-find-bad-style t]
-           ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
-           ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
-           ["CPerl pretty print (exprmntl)" cperl-ps-print
-            (fboundp 'ps-extend-face-list)]
-           ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]
-           ("Tags"
+          ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
+          ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
+          ("Tags"
 ;;;          ["Create tags for current file" cperl-etags t]
 ;;;          ["Add tags for current file" (cperl-etags t) t]
 ;;;          ["Create tags for Perl files in directory" (cperl-etags nil t) t]
@@ -1186,10 +1350,10 @@ the faces: please specify bold, italic, underline, shadow and box.)
           ["PerlStyle" (cperl-set-style "PerlStyle") t]
           ["GNU" (cperl-set-style "GNU") t]
           ["C++" (cperl-set-style "C++") t]
-          ["FSF" (cperl-set-style "FSF") t]
+          ["K&R" (cperl-set-style "K&R") t]
           ["BSD" (cperl-set-style "BSD") t]
           ["Whitesmith" (cperl-set-style "Whitesmith") t]
-          ["Current" (cperl-set-style "Current") t]
+          ["Memorize Current" (cperl-set-style "Current") t]
           ["Memorized" (cperl-set-style-back) cperl-old-style])
          ("Micro-docs"
           ["Tips" (describe-variable 'cperl-tips) t]
@@ -1208,12 +1372,73 @@ the faces: please specify bold, italic, underline, shadow and box.)
 The expansion is entirely correct because it uses the C preprocessor."
   t)
 
+;;; These two must be unwound, otherwise take exponential time
+(defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*"
+"Regular expression to match optional whitespace with interpspersed comments.
+Should contain exactly one group.")
+
+;;; This one is tricky to unwind; still very inefficient...
+(defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+"
+"Regular expression to match whitespace with interpspersed comments.
+Should contain exactly one group.")
+
+
+;;; Is incorporated in `cperl-imenu--function-name-regexp-perl'
+;;; `cperl-outline-regexp', `defun-prompt-regexp'.
+;;; Details of groups in this may be used in several functions; see comments
+;;; near mentioned above variable(s)...
+;;; sub($$):lvalue{}  sub:lvalue{} Both allowed...
+(defsubst cperl-after-sub-regexp (named attr) ; 9 groups without attr...
+  "Match the text after `sub' in a subroutine declaration.
+If NAMED is nil, allows anonymous subroutines.  Matches up to the first \":\"
+of attributes (if present), or end of the name or prototype (whatever is
+the last)."
+  (concat                               ; Assume n groups before this...
+   "\\("                                ; n+1=name-group
+     cperl-white-and-comment-rex        ; n+2=pre-name
+     "\\(::[a-zA-Z_0-9:']+\\|[a-zA-Z_'][a-zA-Z_0-9:']*\\)" ; n+3=name
+   "\\)"                                ; END n+1=name-group
+   (if named "" "?")
+   "\\("                                ; n+4=proto-group
+     cperl-maybe-white-and-comment-rex  ; n+5=pre-proto
+     "\\(([^()]*)\\)"                   ; n+6=prototype
+   "\\)?"                               ; END n+4=proto-group
+   "\\("                                ; n+7=attr-group
+     cperl-maybe-white-and-comment-rex  ; n+8=pre-attr
+     "\\("                              ; n+9=start-attr
+        ":"
+        (if attr (concat
+                  "\\("
+                     cperl-maybe-white-and-comment-rex ; whitespace-comments
+                     "\\(\\sw\\|_\\)+"  ; attr-name
+                     ;; attr-arg (1 level of internal parens allowed!)
+                     "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?"
+                     "\\("              ; optional : (XXX allows trailing???)
+                        cperl-maybe-white-and-comment-rex ; whitespace-comments
+                     ":\\)?"
+                  "\\)+")
+          "[^:]")
+     "\\)"
+   "\\)?"                               ; END n+6=proto-group
+   ))
+
+;;; 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)
 (defvar cperl-imenu--function-name-regexp-perl
   (concat
-   "^\\("
-       "[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?"
-     "\\|"
-       "=head\\([12]\\)[ \t]+\\([^\n]+\\)$"
+   "^\\("                               ; 1 = all
+       "\\([ \t]*package"               ; 2 = package-group
+          "\\("                         ; 3 = package-name-group
+            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
+   "\\|"
+     "=head\\([1-4]\\)[ \t]+"           ; 16=level
+     "\\([^\n]+\\)$"                    ; 17=text
    "\\)"))
 
 (defvar cperl-outline-regexp
@@ -1225,6 +1450,12 @@ The expansion is entirely correct because it uses the C preprocessor."
 (defvar cperl-string-syntax-table nil
   "Syntax table in use in CPerl mode string-like chunks.")
 
+(defsubst cperl-1- (p)
+  (max (point-min) (1- p)))
+
+(defsubst cperl-1+ (p)
+  (min (point-max) (1+ p)))
+
 (if cperl-mode-syntax-table
     ()
   (setq cperl-mode-syntax-table (make-syntax-table))
@@ -1249,6 +1480,8 @@ The expansion is entirely correct because it uses the C preprocessor."
   (modify-syntax-entry ?| "." cperl-mode-syntax-table)
   (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))
   (modify-syntax-entry ?$ "." cperl-string-syntax-table)
+  (modify-syntax-entry ?\{ "." cperl-string-syntax-table)
+  (modify-syntax-entry ?\} "." cperl-string-syntax-table)
   (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment )
 
 
@@ -1257,6 +1490,10 @@ The expansion is entirely correct because it uses the C preprocessor."
 ;; Fix for msb.el
 (defvar cperl-msb-fixed nil)
 (defvar cperl-use-major-mode 'cperl-mode)
+(defvar cperl-font-lock-multiline-start nil)
+(defvar cperl-font-lock-multiline nil)
+(defvar cperl-compilation-error-regexp-alist nil)
+(defvar cperl-font-locking nil)
 
 ;;;###autoload
 (defun cperl-mode ()
@@ -1402,16 +1639,24 @@ Variables controlling indentation style:
  `cperl-min-label-indent'
     Minimal indentation for line that is a label.
 
-Settings for K&R and BSD indentation styles are
-  `cperl-indent-level'                5    8
-  `cperl-continued-statement-offset'  5    8
-  `cperl-brace-offset'               -5   -8
-  `cperl-label-offset'               -5   -8
+Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
+  `cperl-indent-level'                5   4       2   4
+  `cperl-brace-offset'                0   0       0   0
+  `cperl-continued-brace-offset'     -5  -4       0   0
+  `cperl-label-offset'               -5  -4      -2  -4
+  `cperl-continued-statement-offset'  5   4       2   4
 
 CPerl knows several indentation styles, and may bulk set the
 corresponding variables.  Use \\[cperl-set-style] to do this.  Use
 \\[cperl-set-style-back] to restore the memorized preexisting values
-\(both available from menu).
+\(both available from menu).  See examples in `cperl-style-examples'.
+
+Part of the indentation style is how different parts of if/elsif/else
+statements are broken into lines; in CPerl, this is reflected on how
+templates for these constructs are created (controlled by
+`cperl-extra-newline-before-brace'), and how reflow-logic should treat \"continuation\" blocks of else/elsif/continue, controlled by the same variable,
+and by `cperl-extra-newline-before-brace-multiline',
+`cperl-merge-trailing-else', `cperl-indent-region-fix-constructs'.
 
 If `cperl-indent-level' is 0, the statement after opening brace in
 column 0 is indented on
@@ -1465,8 +1710,12 @@ or as help on variables `cperl-tips', `cperl-problems',
                 ("head2" "head2" cperl-electric-pod 0)))
         (setq abbrevs-changed prev-a-c)))
   (setq local-abbrev-table cperl-mode-abbrev-table)
-  (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0))
+  (if (cperl-val 'cperl-electric-keywords)
+      (abbrev-mode 1))
   (set-syntax-table cperl-mode-syntax-table)
+  ;; Until Emacs is multi-threaded, we do not actually need it local:
+  (make-local-variable 'cperl-font-lock-multiline-start)
+  (make-local-variable 'cperl-font-locking)
   (make-local-variable 'outline-regexp)
   ;; (setq outline-regexp imenu-example--function-name-regexp-perl)
   (setq outline-regexp cperl-outline-regexp)
@@ -1478,7 +1727,10 @@ or as help on variables `cperl-tips', `cperl-problems',
   (setq paragraph-separate paragraph-start)
   (make-local-variable 'paragraph-ignore-fill-prefix)
   (setq paragraph-ignore-fill-prefix t)
-  (set (make-local-variable 'fill-paragraph-function) 'cperl-fill-paragraph)
+  (if cperl-xemacs-p
+    (progn
+      (make-local-variable 'paren-backwards-message)
+      (set 'paren-backwards-message t)))
   (make-local-variable 'indent-line-function)
   (setq indent-line-function 'cperl-indent-line)
   (make-local-variable 'require-final-newline)
@@ -1492,9 +1744,22 @@ or as help on variables `cperl-tips', `cperl-problems',
   (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "#+ *")
   (make-local-variable 'defun-prompt-regexp)
-  (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*")
+;;;       "[ \t]*sub"
+;;;       (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
+;;;       cperl-maybe-white-and-comment-rex     ; 15=pre-block
+  (setq defun-prompt-regexp
+        (concat "^[ \t]*\\(sub"
+                (cperl-after-sub-regexp 'named 'attr-groups)
+                "\\|"                   ; per toke.c
+                "\\(BEGIN\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
+                "\\)"
+                cperl-maybe-white-and-comment-rex))
   (make-local-variable 'comment-indent-function)
   (setq comment-indent-function 'cperl-comment-indent)
+  (and (boundp 'fill-paragraph-function)
+      (progn
+        (make-local-variable 'fill-paragraph-function)
+        (set 'fill-paragraph-function 'cperl-fill-paragraph)))
   (make-local-variable 'parse-sexp-ignore-comments)
   (setq parse-sexp-ignore-comments t)
   (make-local-variable 'indent-region-function)
@@ -1509,21 +1774,40 @@ or as help on variables `cperl-tips', `cperl-problems',
   (set 'vc-rcs-header cperl-vc-rcs-header)
   (make-local-variable 'vc-sccs-header)
   (set 'vc-sccs-header cperl-vc-sccs-header)
+  ;; This one is obsolete...
+  (make-local-variable 'vc-header-alist)
+  (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
+                            (` ((SCCS (, (car cperl-vc-sccs-header)))
+                                     (RCS (, (car cperl-vc-rcs-header)))))))
+  (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
+         (make-local-variable 'compilation-error-regexp-alist-alist)
+         (set 'compilation-error-regexp-alist-alist
+              (cons (cons 'cperl cperl-compilation-error-regexp-alist)
+                    (symbol-value 'compilation-error-regexp-alist-alist)))
+         (if (fboundp 'compilation-build-compilation-error-regexp-alist)
+             (let ((f 'compilation-build-compilation-error-regexp-alist))
+               (funcall f))
+           (push 'cperl compilation-error-regexp-alist)))
+        ((boundp 'compilation-error-regexp-alist);; xmeacs 19.x
+         (make-local-variable 'compilation-error-regexp-alist)
+         (set 'compilation-error-regexp-alist
+               (cons cperl-compilation-error-regexp-alist
+                     (symbol-value 'compilation-error-regexp-alist)))))
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults
         (cond
          ((string< emacs-version "19.30")
-          '(cperl-font-lock-keywords-2))
+          '(cperl-font-lock-keywords-2 nil nil ((?_ . "w"))))
          ((string< emacs-version "19.33") ; Which one to use?
           '((cperl-font-lock-keywords
              cperl-font-lock-keywords-1
-             cperl-font-lock-keywords-2)))
+             cperl-font-lock-keywords-2) nil nil ((?_ . "w"))))
          (t
           '((cperl-load-font-lock-keywords
              cperl-load-font-lock-keywords-1
-             cperl-load-font-lock-keywords-2)
-            nil nil ((?_ . "w"))))))
+             cperl-load-font-lock-keywords-2) nil nil ((?_ . "w"))))))
   (make-local-variable 'cperl-syntax-state)
+  (setq cperl-syntax-state nil)         ; reset syntaxification cache
   (if cperl-use-syntax-table-text-property
       (progn
         (make-local-variable 'parse-sexp-lookup-properties)
@@ -1533,10 +1817,12 @@ or as help on variables `cperl-tips', `cperl-problems',
         (or (boundp 'font-lock-unfontify-region-function)
             (set 'font-lock-unfontify-region-function
                  'font-lock-default-unfontify-region))
-        (make-local-variable 'font-lock-unfontify-region-function)
-        (set 'font-lock-unfontify-region-function ; not present with old Emacs
-              'cperl-font-lock-unfontify-region-function)
+        (unless cperl-xemacs-p          ; Our: just a plug for wrong font-lock
+          (make-local-variable 'font-lock-unfontify-region-function)
+          (set 'font-lock-unfontify-region-function ; not present with old Emacs
+               'cperl-font-lock-unfontify-region-function))
         (make-local-variable 'cperl-syntax-done-to)
+        (setq cperl-syntax-done-to nil) ; reset syntaxification cache
         (make-local-variable 'font-lock-syntactic-keywords)
         (setq font-lock-syntactic-keywords
               (if cperl-syntaxify-by-font-lock
@@ -1546,10 +1832,20 @@ or as help on variables `cperl-tips', `cperl-problems',
                 ;;  to make font-lock think that font-lock-syntactic-keywords
                 ;;  are defined.
                 '(t)))))
+  (if (boundp 'font-lock-multiline)     ; Newer font-lock; use its facilities
+      (progn
+        (setq cperl-font-lock-multiline t) ; Not localized...
+        (set 'font-lock-multiline t)) ; not present with old Emacs; auto-local
+    (make-local-variable 'font-lock-fontify-region-function)
+    (set 'font-lock-fontify-region-function ; not present with old Emacs
+         'cperl-font-lock-fontify-region-function))
+  (make-local-variable 'font-lock-fontify-region-function)
+  (set 'font-lock-fontify-region-function ; not present with old Emacs
+       'cperl-font-lock-fontify-region-function)
   (make-local-variable 'cperl-old-style)
   (if (boundp 'normal-auto-fill-function) ; 19.33 and later
       (set (make-local-variable 'normal-auto-fill-function)
-           'cperl-do-auto-fill)       ; RMS has it as #'cperl-do-auto-fill ???
+           'cperl-do-auto-fill)
     (or (fboundp 'cperl-old-auto-fill-mode)
         (progn
           (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
@@ -1562,12 +1858,18 @@ or as help on variables `cperl-tips', `cperl-problems',
       (if (cperl-val 'cperl-font-lock)
           (progn (or cperl-faces-init (cperl-init-faces))
                  (font-lock-mode 1))))
+  (set (make-local-variable 'facemenu-add-face-function)
+       'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
   (and (boundp 'msb-menu-cond)
        (not cperl-msb-fixed)
        (cperl-msb-fix))
   (if (featurep 'easymenu)
       (easy-menu-add cperl-menu))       ; A NOP in Emacs.
   (run-mode-hooks 'cperl-mode-hook)
+  (if cperl-hook-after-change
+      (progn
+        (make-local-hook 'after-change-functions)
+        (add-hook 'after-change-functions 'cperl-after-change-function nil t)))
   ;; After hooks since fontification will break this
   (if cperl-pod-here-scan
       (or cperl-syntaxify-by-font-lock
@@ -1616,31 +1918,37 @@ or as help on variables `cperl-tips', `cperl-problems',
 (defvar cperl-st-ket '(5 . ?\<))
 
 
-(defun cperl-comment-indent ()
+(defun cperl-comment-indent ()          ; called at point at supposed comment
   (let ((p (point)) (c (current-column)) was phony)
-    (if (looking-at "^#") 0             ; Existing comment at bol stays there.
+    (if (and (not cperl-indent-comment-at-column-0)
+             (looking-at "^#"))
+        0       ; Existing comment at bol stays there.
       ;; Wrong comment found
       (save-excursion
         (setq was (cperl-to-comment-or-eol)
               phony (eq (get-text-property (point) 'syntax-table)
                         cperl-st-cfence))
         (if phony
-            (progn
+            (progn                      ; Too naive???
               (re-search-forward "#\\|$") ; Hmm, what about embedded #?
               (if (eq (preceding-char) ?\#)
                   (forward-char -1))
               (setq was nil)))
-        (if (= (point) p)
+        (if (= (point) p)               ; Our caller found a correct place
             (progn
               (skip-chars-backward " \t")
-              (max (1+ (current-column)) ; Else indent at comment column
-                   comment-column))
+              (setq was (current-column))
+              (if (eq was 0)
+                  comment-column
+                (max (1+ was) ; Else indent at comment column
+                     comment-column)))
+          ;; No, the caller found a random place; we need to edit ourselves
           (if was nil
             (insert comment-start)
             (backward-char (length comment-start)))
           (setq cperl-wrong-comment t)
-          (indent-to comment-column 1)  ; Indent minimum 1
-          c)))))                        ; except leave at least one space.
+          (cperl-make-indent comment-column 1) ; Indent min 1
+          c)))))
 
 ;;;(defun cperl-comment-indent-fallback ()
 ;;;  "Is called if the standard comment-search procedure fails.
@@ -1666,7 +1974,7 @@ or as help on variables `cperl-tips', `cperl-problems',
   (interactive)
   (let (cperl-wrong-comment)
     (indent-for-comment)
-    (if cperl-wrong-comment
+    (if cperl-wrong-comment             ; set by `cperl-comment-indent'
         (progn (cperl-to-comment-or-eol)
                (forward-char (length comment-start))))))
 
@@ -1966,15 +2274,10 @@ to nil."
             (or
              (get-text-property (point) 'in-pod)
              (cperl-after-expr-p nil "{;:")
-             (and (re-search-backward
-                   ;; "\\(\\`\n?\\|\n\n\\)=\\sw+"
-                   "\\(\\`\n?\\|^\n\\)=\\sw+"
-                   (point-min) t)
-                  (not (or
-                        (looking-at "=cut")
-                        (and cperl-use-syntax-table-text-property
-                             (not (eq (get-text-property (point) 'syntax-type)
-                                      'pod)))))))))
+             (and (re-search-backward "\\(\\`\n?\\|^\n\\)=\\sw+" (point-min) t)
+                  (not (looking-at "\n*=cut"))
+                  (or (not cperl-use-syntax-table-text-property)
+                      (eq (get-text-property (point) 'syntax-type) 'pod))))))
          (progn
            (save-excursion
              (setq notlast (re-search-forward "^\n=" nil t)))
@@ -2252,7 +2555,7 @@ key.  Will untabify if `cperl-electric-backspace-untabify' is non-nil."
 
 (put 'cperl-electric-backspace 'delete-selection 'supersede)
 
-(defun cperl-inside-parens-p ()
+(defun cperl-inside-parens-p ()         ;; NOT USED????
   (condition-case ()
       (save-excursion
         (save-restriction
@@ -2332,8 +2635,9 @@ Return the amount the indentation changed by."
             (zerop shift-amt))
         (if (> (- (point-max) pos) (point))
             (goto-char (- (point-max) pos)))
-      (delete-region beg (point))
-      (indent-to indent)
+      ;;;(delete-region beg (point))
+      ;;;(indent-to indent)
+      (cperl-make-indent indent)
       ;; If initial point was within line's indentation,
       ;; position after the indentation.  Else stay at same point in text.
       (if (> (- (point-max) pos) (point))
@@ -2380,63 +2684,55 @@ Return the amount the indentation changed by."
       (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
       (list start state depth prestart))))
 
-(defun cperl-block-p ()            ; Do not C-M-q !  One string contains ";" !
-  ;; Positions is before ?\{.  Checks whether it starts a block.
-  ;; No save-excursion!
-  (cperl-backward-to-noncomment (point-min))
-  (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label!  \C-@ at bobp
-                                        ; Label may be mixed up with `$blah :'
-      (save-excursion (cperl-after-label))
-      (and (memq (char-syntax (preceding-char)) '(?w ?_))
-           (progn
-             (backward-sexp)
-             ;; Need take into account `bless', `return', `tr',...
-             (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax
-                      (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>")))
-                 (progn
-                   (skip-chars-backward " \t\n\f")
-                   (and (memq (char-syntax (preceding-char)) '(?w ?_))
-                        (progn
-                          (backward-sexp)
-                          (looking-at
-                           "sub[ \t]+[a-zA-Z0-9_:]+[ \t\n\f]*\\(([^()]*)[ \t\n\f]*\\)?[#{]")))))))))
-
 (defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group)))
 
-(defun cperl-calculate-indent (&optional parse-data) ; was parse-start
-  "Return appropriate indentation for current line as Perl code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment.
-
-Will not correct the indentation for labels, but will correct it for braces
-and closing parentheses and brackets."
+(defun cperl-beginning-of-property (p prop &optional lim)
+  "Given that P has a property PROP, find where the property starts.
+Will not look before LIM."
+  ;;; XXXX What to do at point-max???
+  (or (previous-single-property-change (cperl-1+ p) prop lim)
+      (point-min))
+;;;  (cond ((eq p (point-min))
+;;;      p)
+;;;     ((and lim (<= p lim))
+;;;      p)
+;;;     ((not (get-text-property (1- p) prop))
+;;;      p)
+;;;     (t (or (previous-single-property-change p look-prop lim)
+;;;            (point-min))))
+  )
+
+(defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start
+  ;; Old workhorse for calculation of indentation; the major problem
+  ;; is that it mixes the sniffer logic to understand what the current line
+  ;; MEANS with the logic to actually calculate where to indent it.
+  ;; The latter part should be eventually moved to `cperl-calculate-indent';
+  ;; actually, this is mostly done now...
   (cperl-update-syntaxification (point) (point))
-  (save-excursion
-    (if (or
-         (and (memq (get-text-property (point) 'syntax-type)
-                    '(pod here-doc here-doc-delim format))
-              (not (get-text-property (point) 'indentable)))
-         ;; before start of POD - whitespace found since do not have 'pod!
-         (and (looking-at "[ \t]*\n=")
-              (error "Spaces before POD section!"))
-         (and (not cperl-indent-left-aligned-comments)
-              (looking-at "^#")))
-        nil
-      (beginning-of-line)
-      (let ((indent-point (point))
-            (char-after (save-excursion
-                          (skip-chars-forward " \t")
-                          (following-char)))
-            (in-pod (get-text-property (point) 'in-pod))
-            (pre-indent-point (point))
-            p prop look-prop is-block delim)
-        (cond
-         (in-pod
-          ;; In the verbatim part, probably code example.  What to do???
-          )
-         (t
-          (save-excursion
-            ;; Not in POD
+  (let ((res (get-text-property (point) 'syntax-type)))
+    (save-excursion
+      (cond
+       ((and (memq res '(pod here-doc here-doc-delim format))
+             (not (get-text-property (point) 'indentable)))
+        (vector res))
+       ;; before start of POD - whitespace found since do not have 'pod!
+       ((looking-at "[ \t]*\n=")
+        (error "Spaces before POD section!"))
+       ((and (not cperl-indent-left-aligned-comments)
+             (looking-at "^#"))
+        [comment-special:at-beginning-of-line])
+       ((get-text-property (point) 'in-pod)
+        [in-pod])
+       (t
+        (beginning-of-line)
+        (let* ((indent-point (point))
+               (char-after-pos (save-excursion
+                                 (skip-chars-forward " \t")
+                                 (point)))
+               (char-after (char-after char-after-pos))
+               (pre-indent-point (point))
+               p prop look-prop is-block delim)
+          (save-excursion               ; Know we are not in POD, find appropriate pos before
             (cperl-backward-to-noncomment nil)
             (setq p (max (point-min) (1- (point)))
                   prop (get-text-property p 'syntax-type)
@@ -2444,437 +2740,597 @@ and closing parentheses and brackets."
                                 'syntax-type))
             (if (memq prop '(pod here-doc format here-doc-delim))
                 (progn
-                  (goto-char (or (previous-single-property-change p look-prop)
-                                 (point-min)))
+                  (goto-char (cperl-beginning-of-property p look-prop))
                   (beginning-of-line)
-                  (setq pre-indent-point (point)))))))
-        (goto-char pre-indent-point)
-        (let* ((case-fold-search nil)
-               (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
-               (start (or (nth 2 parse-data)
-                          (nth 0 s-s)))
-               (state (nth 1 s-s))
-               (containing-sexp (car (cdr state)))
-               old-indent)
-          (if (and
-               ;;containing-sexp                ;; We are buggy at toplevel :-(
-               parse-data)
-              (progn
-                (setcar parse-data pre-indent-point)
-                (setcar (cdr parse-data) state)
-                (or (nth 2 parse-data)
-                    (setcar (cddr parse-data) start))
-                ;; Before this point: end of statement
-                (setq old-indent (nth 3 parse-data))))
-          (cond ((get-text-property (point) 'indentable)
-                 ;; indent to just after the surrounding open,
-                 ;; skip blanks if we do not close the expression.
-                 (goto-char (1+ (previous-single-property-change (point) 'indentable)))
-                 (or (memq char-after (append ")]}" nil))
-                     (looking-at "[ \t]*\\(#\\|$\\)")
-                     (skip-chars-forward " \t"))
-                 (current-column))
-                ((or (nth 3 state) (nth 4 state))
-                 ;; return nil or t if should not change this line
-                 (nth 4 state))
-                ;; XXXX Do we need to special-case this?
-                ((null containing-sexp)
-                 ;; Line is at top level.  May be data or function definition,
-                 ;; or may be function argument declaration.
-                 ;; Indent like the previous top level line
-                 ;; unless that ends in a closeparen without semicolon,
-                 ;; in which case this line is the first argument decl.
-                 (skip-chars-forward " \t")
-                 (+ (save-excursion
-                      (goto-char start)
-                      (- (current-indentation)
-                         (if (nth 2 s-s) cperl-indent-level 0)))
-                    (if (= char-after ?{) cperl-continued-brace-offset 0)
-                    (progn
-                      (cperl-backward-to-noncomment (or old-indent (point-min)))
-                      ;; Look at previous line that's at column 0
-                      ;; to determine whether we are in top-level decls
-                      ;; or function's arg decls.  Set basic-indent accordingly.
-                      ;; Now add a little if this is a continuation line.
-                      (if (or (bobp)
-                              (eq (point) old-indent) ; old-indent was at comment
-                              (eq (preceding-char) ?\;)
-                              ;;  Had ?\) too
-                              (and (eq (preceding-char) ?\})
-                                   (cperl-after-block-and-statement-beg
-                                    (point-min))) ; Was start - too close
-                              (memq char-after (append ")]}" nil))
-                              (and (eq (preceding-char) ?\:) ; label
-                                   (progn
-                                     (forward-sexp -1)
-                                     (skip-chars-backward " \t")
-                                     (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
-                              (get-text-property (point) 'first-format-line))
-                          (progn
-                            (if (and parse-data
-                                     (not (eq char-after ?\C-j)))
-                                (setcdr (cddr parse-data)
-                                        (list pre-indent-point)))
-                            0)
-                        cperl-continued-statement-offset))))
-                ((not
-                  (or (setq is-block
-                            (and (setq delim (= (char-after containing-sexp) ?{))
-                                 (save-excursion ; Is it a hash?
-                                   (goto-char containing-sexp)
-                                   (cperl-block-p))))
-                      cperl-indent-parens-as-block))
-                 ;; group is an expression, not a block:
-                 ;; indent to just after the surrounding open parens,
-                 ;; skip blanks if we do not close the expression.
-                 (goto-char (1+ containing-sexp))
-                 (or (memq char-after
-                           (append (if delim "}" ")]}") nil))
-                     (looking-at "[ \t]*\\(#\\|$\\)")
-                     (skip-chars-forward " \t"))
-                 (+ (current-column)
-                    (if (and delim
-                             (eq char-after ?\}))
-                        ;; Correct indentation of trailing ?\}
-                        (+ cperl-indent-level cperl-close-paren-offset)
-                      0)))
-;;;           ((and (/= (char-after containing-sexp) ?{)
-;;;                 (not cperl-indent-parens-as-block))
-;;;            ;; line is expression, not statement:
-;;;            ;; indent to just after the surrounding open,
-;;;            ;; skip blanks if we do not close the expression.
-;;;            (goto-char (1+ containing-sexp))
-;;;            (or (memq char-after (append ")]}" nil))
-;;;                (looking-at "[ \t]*\\(#\\|$\\)")
-;;;                (skip-chars-forward " \t"))
-;;;            (current-column))
-;;;           ((progn
-;;;              ;; Containing-expr starts with \{.  Check whether it is a hash.
-;;;              (goto-char containing-sexp)
-;;;              (and (not (cperl-block-p))
-;;;                   (not cperl-indent-parens-as-block)))
-;;;            (goto-char (1+ containing-sexp))
-;;;            (or (eq char-after ?\})
-;;;                (looking-at "[ \t]*\\(#\\|$\\)")
-;;;                (skip-chars-forward " \t"))
-;;;            (+ (current-column)      ; Correct indentation of trailing ?\}
-;;;               (if (eq char-after ?\}) (+ cperl-indent-level
-;;;                                          cperl-close-paren-offset)
-;;;                 0)))
-                (t
-                 ;; Statement level.  Is it a continuation or a new statement?
-                 ;; Find previous non-comment character.
-                 (goto-char pre-indent-point)
-                 (cperl-backward-to-noncomment containing-sexp)
-                 ;; Back up over label lines, since they don't
-                 ;; affect whether our line is a continuation.
-                 ;; (Had \, too)
-                 (while ;;(or (eq (preceding-char) ?\,)
-                     (and (eq (preceding-char) ?:)
-                          (or ;;(eq (char-after (- (point) 2)) ?\') ; ????
-                           (memq (char-syntax (char-after (- (point) 2)))
-                                 '(?w ?_))))
-                   ;;)
-                   (if (eq (preceding-char) ?\,)
-                       ;; Will go to beginning of line, essentially.
-                       ;; Will ignore embedded sexpr XXXX.
-                       (cperl-backward-to-start-of-continued-exp containing-sexp))
-                   (beginning-of-line)
-                   (cperl-backward-to-noncomment containing-sexp))
-                 ;; Now we get the answer.
-                 (if (not (or (eq (1- (point)) containing-sexp)
-                              (memq (preceding-char)
-                                    (append (if is-block " ;{" " ,;{") '(nil)))
-                              (and (eq (preceding-char) ?\})
-                                   (cperl-after-block-and-statement-beg
-                                    containing-sexp))
-                              (get-text-property (point) 'first-format-line)))
-                     ;; This line is continuation of preceding line's statement;
-                     ;; indent  `cperl-continued-statement-offset'  more than the
-                     ;; previous line of the statement.
-                     ;;
-                     ;; There might be a label on this line, just
-                     ;; consider it bad style and ignore it.
-                     (progn
-                       (cperl-backward-to-start-of-continued-exp containing-sexp)
-                       (+ (if (memq char-after (append "}])" nil))
-                              0         ; Closing parenth
-                            cperl-continued-statement-offset)
-                          (if (or is-block
-                                  (not delim)
-                                  (not (eq char-after ?\})))
-                              0
-                            ;; Now it is a hash reference
-                            (+ cperl-indent-level cperl-close-paren-offset))
-                          (if (looking-at "\\w+[ \t]*:")
-                              (if (> (current-indentation) cperl-min-label-indent)
-                                  (- (current-indentation) cperl-label-offset)
-                                ;; Do not move `parse-data', this should
-                                ;; be quick anyway (this comment comes
-                                ;; from different location):
-                                (cperl-calculate-indent))
-                            (current-column))
-                          (if (eq char-after ?\{)
-                              cperl-continued-brace-offset 0)))
-                   ;; This line starts a new statement.
-                   ;; Position following last unclosed open.
-                   (goto-char containing-sexp)
-                   ;; Is line first statement after an open-brace?
-                   (or
-                    ;; If no, find that first statement and indent like
-                    ;; it.  If the first statement begins with label, do
-                    ;; not believe when the indentation of the label is too
-                    ;; small.
-                    (save-excursion
-                      (forward-char 1)
-                      (setq old-indent (current-indentation))
-                      (let ((colon-line-end 0))
-                        (while
-                            (progn (skip-chars-forward " \t\n")
-                                   (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]"))
-                          ;; Skip over comments and labels following openbrace.
-                          (cond ((= (following-char) ?\#)
-                                 (forward-line 1))
-                                ((= (following-char) ?\=)
-                                 (goto-char
-                                  (or (next-single-property-change (point) 'in-pod)
-                                      (point-max)))) ; do not loop if no syntaxification
-                                ;; label:
-                                (t
-                                 (save-excursion (end-of-line)
-                                                 (setq colon-line-end (point)))
-                                 (search-forward ":"))))
-                        ;; The first following code counts
-                        ;; if it is before the line we want to indent.
-                        (and (< (point) indent-point)
-                             (if (> colon-line-end (point)) ; After label
-                                 (if (> (current-indentation)
-                                        cperl-min-label-indent)
-                                     (- (current-indentation) cperl-label-offset)
-                                   ;; Do not believe: `max' is involved
-                                   (+ old-indent cperl-indent-level))
-                               (current-column)))))
-                    ;; If no previous statement,
-                    ;; indent it relative to line brace is on.
-                    ;; For open brace in column zero, don't let statement
-                    ;; start there too.  If cperl-indent-level is zero,
-                    ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
-                    ;; For open-braces not the first thing in a line,
-                    ;; add in cperl-brace-imaginary-offset.
-
-                    ;; If first thing on a line:  ?????
-                    (+ (if (and (bolp) (zerop cperl-indent-level))
-                           (+ cperl-brace-offset cperl-continued-statement-offset)
-                         cperl-indent-level)
-                       (if (or is-block
-                               (not delim)
-                               (not (eq char-after ?\})))
-                           0
-                         ;; Now it is a hash reference
-                         (+ cperl-indent-level cperl-close-paren-offset))
-                       ;; Move back over whitespace before the openbrace.
-                       ;; If openbrace is not first nonwhite thing on the line,
-                       ;; add the cperl-brace-imaginary-offset.
-                       (progn (skip-chars-backward " \t")
-                              (if (bolp) 0 cperl-brace-imaginary-offset))
-                       ;; If the openbrace is preceded by a parenthesized exp,
-                       ;; move to the beginning of that;
-                       ;; possibly a different line
-                       (progn
-                         (if (eq (preceding-char) ?\))
-                             (forward-sexp -1))
-                         ;; In the case it starts a subroutine, indent with
-                         ;; respect to `sub', not with respect to the
-                         ;; first thing on the line, say in the case of
-                         ;; anonymous sub in a hash.
-                         ;;
-                         (skip-chars-backward " \t")
-                         (if (and (eq (preceding-char) ?b)
+                  (setq pre-indent-point (point)))))
+          (goto-char pre-indent-point)  ; Orig line skipping preceeding pod/etc
+          (let* ((case-fold-search nil)
+                 (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
+                 (start (or (nth 2 parse-data) ; last complete sexp terminated
+                            (nth 0 s-s))) ; Good place to start parsing
+                 (state (nth 1 s-s))
+                 (containing-sexp (car (cdr state)))
+                 old-indent)
+            (if (and
+                 ;;containing-sexp              ;; We are buggy at toplevel :-(
+                 parse-data)
+                (progn
+                  (setcar parse-data pre-indent-point)
+                  (setcar (cdr parse-data) state)
+                  (or (nth 2 parse-data)
+                      (setcar (cddr parse-data) start))
+                  ;; Before this point: end of statement
+                  (setq old-indent (nth 3 parse-data))))
+            (cond ((get-text-property (point) 'indentable)
+                   ;; indent to "after" the surrounding open
+                   ;; (same offset as `cperl-beautify-regexp-piece'),
+                   ;; skip blanks if we do not close the expression.
+                   (setq delim          ; We do not close the expression
+                         (get-text-property
+                          (cperl-1+ char-after-pos) 'indentable)
+                         p (1+ (cperl-beginning-of-property
+                                (point) 'indentable))
+                         is-block       ; misused for: preceeding line in REx
+                         (save-excursion ; Find preceeding line
+                           (cperl-backward-to-noncomment p)
+                           (beginning-of-line)
+                           (if (<= (point) p)
+                               (progn   ; get indent from the first line
+                                 (goto-char p)
+                                 (skip-chars-forward " \t")
+                                 (if (memq (char-after (point))
+                                           (append "#\n" nil))
+                                     nil ; Can't use intentation of this line...
+                                   (point)))
+                             (skip-chars-forward " \t")
+                             (point)))
+                         prop (parse-partial-sexp p char-after-pos))
+                   (cond ((not delim)   ; End the REx, ignore is-block
+                          (vector 'indentable 'terminator p is-block))
+                         (is-block      ; Indent w.r.t. preceeding line
+                          (vector 'indentable 'cont-line char-after-pos
+                                  is-block char-after p))
+                         (t             ; No preceeding line...
+                          (vector 'indentable 'first-line p))))
+                  ((get-text-property char-after-pos 'REx-part2)
+                   (vector 'REx-part2 (point)))
+                  ((nth 3 state)
+                   [comment])
+                  ((nth 4 state)
+                   [string])
+                  ;; XXXX Do we need to special-case this?
+                  ((null containing-sexp)
+                   ;; Line is at top level.  May be data or function definition,
+                   ;; or may be function argument declaration.
+                   ;; Indent like the previous top level line
+                   ;; unless that ends in a closeparen without semicolon,
+                   ;; in which case this line is the first argument decl.
+                   (skip-chars-forward " \t")
+                   (cperl-backward-to-noncomment (or old-indent (point-min)))
+                   (setq state
+                         (or (bobp)
+                             (eq (point) old-indent) ; old-indent was at comment
+                             (eq (preceding-char) ?\;)
+                             ;;  Had ?\) too
+                             (and (eq (preceding-char) ?\})
+                                  (cperl-after-block-and-statement-beg
+                                   (point-min))) ; Was start - too close
+                             (memq char-after (append ")]}" nil))
+                             (and (eq (preceding-char) ?\:) ; label
                                   (progn
                                     (forward-sexp -1)
-                                    (looking-at "sub\\>"))
-                                  (setq old-indent
-                                        (nth 1
-                                             (parse-partial-sexp
-                                              (save-excursion (beginning-of-line) (point))
-                                              (point)))))
-                             (progn (goto-char (1+ old-indent))
-                                    (skip-chars-forward " \t")
-                                    (current-column))
-                           ;; Get initial indentation of the line we are on.
-                           ;; If line starts with label, calculate label indentation
-                           (if (save-excursion
-                                 (beginning-of-line)
-                                 (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
-                               (if (> (current-indentation) cperl-min-label-indent)
-                                   (- (current-indentation) cperl-label-offset)
-                                 ;; Do not move `parse-data', this should
-                                 ;; be quick anyway:
-                                 (cperl-calculate-indent))
-                             (current-indentation))))))))))))))
-
-;; (defvar cperl-indent-alist
-;;   '((string nil)
-;;     (comment nil)
-;;     (toplevel 0)
-;;     (toplevel-after-parenth 2)
-;;     (toplevel-continued 2)
-;;     (expression 1))
-;;   "Alist of indentation rules for CPerl mode.
-;; The values mean:
-;;   nil: do not indent;
-;;   number: add this amount of indentation.
-
-;; Not finished, not used.")
-
-;; (defun cperl-where-am-i (&optional parse-start start-state)
-;;   ;; Unfinished
-;;   "Return a list of lists ((TYPE POS)...) of good points before the point.
-;; ;; POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'.
-
-;; ;; Not finished, not used."
-;;   (save-excursion
-;;     (let* ((start-point (point))
-;;         (s-s (cperl-get-state))
-;;         (start (nth 0 s-s))
-;;         (state (nth 1 s-s))
-;;         (prestart (nth 3 s-s))
-;;         (containing-sexp (car (cdr state)))
-;;         (case-fold-search nil)
-;;         (res (list (list 'parse-start start) (list 'parse-prestart prestart))))
-;;       (cond ((nth 3 state)           ; In string
-;;           (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string
-;;          ((nth 4 state)              ; In comment
-;;           (setq res (cons '(comment) res)))
-;;          ((null containing-sexp)
-;;           ;; Line is at top level.
-;;           ;; Indent like the previous top level line
-;;           ;; unless that ends in a closeparen without semicolon,
-;;           ;; in which case this line is the first argument decl.
-;;           (cperl-backward-to-noncomment (or parse-start (point-min)))
-;;           ;;(skip-chars-backward " \t\f\n")
-;;           (cond
-;;            ((or (bobp)
-;;                 (memq (preceding-char) (append ";}" nil)))
-;;             (setq res (cons (list 'toplevel start) res)))
-;;            ((eq (preceding-char) ?\) )
-;;             (setq res (cons (list 'toplevel-after-parenth start) res)))
-;;            (t
-;;             (setq res (cons (list 'toplevel-continued start) res)))))
-;;          ((/= (char-after containing-sexp) ?{)
-;;           ;; line is expression, not statement:
-;;           ;; indent to just after the surrounding open.
-;;           ;; skip blanks if we do not close the expression.
-;;           (setq res (cons (list 'expression-blanks
-;;                                 (progn
-;;                                   (goto-char (1+ containing-sexp))
-;;                                   (or (looking-at "[ \t]*\\(#\\|$\\)")
-;;                                       (skip-chars-forward " \t"))
-;;                                   (point)))
-;;                           (cons (list 'expression containing-sexp) res))))
-;;          ((progn
-;;             ;; Containing-expr starts with \{.  Check whether it is a hash.
-;;             (goto-char containing-sexp)
-;;             (not (cperl-block-p)))
-;;           (setq res (cons (list 'expression-blanks
-;;                                 (progn
-;;                                   (goto-char (1+ containing-sexp))
-;;                                   (or (looking-at "[ \t]*\\(#\\|$\\)")
-;;                                       (skip-chars-forward " \t"))
-;;                                   (point)))
-;;                           (cons (list 'expression containing-sexp) res))))
-;;          (t
-;;           ;; Statement level.
-;;           (setq res (cons (list 'in-block containing-sexp) res))
-;;           ;; Is it a continuation or a new statement?
-;;           ;; Find previous non-comment character.
-;;           (cperl-backward-to-noncomment containing-sexp)
-;;           ;; Back up over label lines, since they don't
-;;           ;; affect whether our line is a continuation.
-;;           ;; Back up comma-delimited lines too ?????
-;;           (while (or (eq (preceding-char) ?\,)
-;;                      (save-excursion (cperl-after-label)))
-;;             (if (eq (preceding-char) ?\,)
-;;                 ;; Will go to beginning of line, essentially
-;;                 ;; Will ignore embedded sexpr XXXX.
-;;                 (cperl-backward-to-start-of-continued-exp containing-sexp))
-;;             (beginning-of-line)
-;;             (cperl-backward-to-noncomment containing-sexp))
-;;           ;; Now we get the answer.
-;;           (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\,
-;;               ;; This line is continuation of preceding line's statement.
-;;               (list (list 'statement-continued containing-sexp))
-;;             ;; This line starts a new statement.
-;;             ;; Position following last unclosed open.
-;;             (goto-char containing-sexp)
-;;             ;; Is line first statement after an open-brace?
-;;             (or
-;;              ;; If no, find that first statement and indent like
-;;              ;; it.  If the first statement begins with label, do
-;;              ;; not believe when the indentation of the label is too
-;;              ;; small.
-;;              (save-excursion
-;;                (forward-char 1)
-;;                (let ((colon-line-end 0))
-;;                  (while (progn (skip-chars-forward " \t\n" start-point)
-;;                                (and (< (point) start-point)
-;;                                     (looking-at
-;;                                      "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))
-;;                    ;; Skip over comments and labels following openbrace.
-;;                    (cond ((= (following-char) ?\#)
-;;                           ;;(forward-line 1)
-;;                           (end-of-line))
-;;                          ;; label:
-;;                          (t
-;;                           (save-excursion (end-of-line)
-;;                                           (setq colon-line-end (point)))
-;;                           (search-forward ":"))))
-;;                  ;; Now at the point, after label, or at start
-;;                  ;; of first statement in the block.
-;;                  (and (< (point) start-point)
-;;                       (if (> colon-line-end (point))
-;;                           ;; Before statement after label
-;;                           (if (> (current-indentation)
-;;                                  cperl-min-label-indent)
-;;                               (list (list 'label-in-block (point)))
-;;                             ;; Do not believe: `max' is involved
-;;                             (list
-;;                              (list 'label-in-block-min-indent (point))))
-;;                         ;; Before statement
-;;                         (list 'statement-in-block (point))))))
-;;              ;; If no previous statement,
-;;              ;; indent it relative to line brace is on.
-;;              ;; For open brace in column zero, don't let statement
-;;              ;; start there too.  If cperl-indent-level is zero,
-;;              ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
-;;              ;; For open-braces not the first thing in a line,
-;;              ;; add in cperl-brace-imaginary-offset.
-
-;;              ;; If first thing on a line:  ?????
-;;              (+ (if (and (bolp) (zerop cperl-indent-level))
-;;                     (+ cperl-brace-offset cperl-continued-statement-offset)
-;;                   cperl-indent-level)
-;;                 ;; Move back over whitespace before the openbrace.
-;;                 ;; If openbrace is not first nonwhite thing on the line,
-;;                 ;; add the cperl-brace-imaginary-offset.
-;;                 (progn (skip-chars-backward " \t")
-;;                        (if (bolp) 0 cperl-brace-imaginary-offset))
-;;                 ;; If the openbrace is preceded by a parenthesized exp,
-;;                 ;; move to the beginning of that;
-;;                 ;; possibly a different line
-;;                 (progn
-;;                   (if (eq (preceding-char) ?\))
-;;                       (forward-sexp -1))
-;;                   ;; Get initial indentation of the line we are on.
-;;                   ;; If line starts with label, calculate label indentation
-;;                   (if (save-excursion
-;;                         (beginning-of-line)
-;;                         (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
-;;                       (if (> (current-indentation) cperl-min-label-indent)
-;;                           (- (current-indentation) cperl-label-offset)
-;;                         (cperl-calculate-indent))
-;;                     (current-indentation))))))))
-;;       res)))
+                                    (skip-chars-backward " \t")
+                                    (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
+                             (get-text-property (point) 'first-format-line)))
+                   
+                   ;; Look at previous line that's at column 0
+                   ;; to determine whether we are in top-level decls
+                   ;; or function's arg decls.  Set basic-indent accordingly.
+                   ;; Now add a little if this is a continuation line.
+                   (and state
+                        parse-data
+                        (not (eq char-after ?\C-j))
+                        (setcdr (cddr parse-data)
+                                (list pre-indent-point)))
+                   (vector 'toplevel start char-after state (nth 2 s-s)))
+                  ((not
+                    (or (setq is-block
+                              (and (setq delim (= (char-after containing-sexp) ?{))
+                                   (save-excursion ; Is it a hash?
+                                     (goto-char containing-sexp)
+                                     (cperl-block-p))))
+                        cperl-indent-parens-as-block))
+                   ;; group is an expression, not a block:
+                   ;; indent to just after the surrounding open parens,
+                   ;; skip blanks if we do not close the expression.
+                   (goto-char (1+ containing-sexp))
+                   (or (memq char-after
+                             (append (if delim "}" ")]}") nil))
+                       (looking-at "[ \t]*\\(#\\|$\\)")
+                       (skip-chars-forward " \t"))
+                   (setq old-indent (point)) ; delim=is-brace
+                   (vector 'in-parens char-after (point) delim containing-sexp))
+                  (t
+                   ;; Statement level.  Is it a continuation or a new statement?
+                   ;; Find previous non-comment character.
+                   (goto-char pre-indent-point) ; Skip one level of POD/etc
+                   (cperl-backward-to-noncomment containing-sexp)
+                   ;; Back up over label lines, since they don't
+                   ;; affect whether our line is a continuation.
+                   ;; (Had \, too)
+                   (while;;(or (eq (preceding-char) ?\,)
+                       (and (eq (preceding-char) ?:)
+                            (or;;(eq (char-after (- (point) 2)) ?\') ; ????
+                             (memq (char-syntax (char-after (- (point) 2)))
+                                   '(?w ?_))))
+                     ;;)
+                     ;; This is always FALSE?
+                     (if (eq (preceding-char) ?\,)
+                         ;; Will go to beginning of line, essentially.
+                         ;; Will ignore embedded sexpr XXXX.
+                         (cperl-backward-to-start-of-continued-exp containing-sexp))
+                     (beginning-of-line)
+                     (cperl-backward-to-noncomment containing-sexp))
+                   ;; Now we get non-label preceeding the indent point
+                   (if (not (or (eq (1- (point)) containing-sexp)
+                                (memq (preceding-char)
+                                      (append (if is-block " ;{" " ,;{") '(nil)))
+                                (and (eq (preceding-char) ?\})
+                                     (cperl-after-block-and-statement-beg
+                                      containing-sexp))
+                                (get-text-property (point) 'first-format-line)))
+                       ;; This line is continuation of preceding line's statement;
+                       ;; indent  `cperl-continued-statement-offset'  more than the
+                       ;; previous line of the statement.
+                       ;;
+                       ;; There might be a label on this line, just
+                       ;; consider it bad style and ignore it.
+                       (progn
+                         (cperl-backward-to-start-of-continued-exp containing-sexp)
+                         (vector 'continuation (point) char-after is-block delim))
+                     ;; This line starts a new statement.
+                     ;; Position following last unclosed open brace
+                     (goto-char containing-sexp)
+                     ;; Is line first statement after an open-brace?
+                     (or
+                      ;; If no, find that first statement and indent like
+                      ;; it.  If the first statement begins with label, do
+                      ;; not believe when the indentation of the label is too
+                      ;; small.
+                      (save-excursion
+                        (forward-char 1)
+                        (let ((colon-line-end 0))
+                          (while
+                              (progn (skip-chars-forward " \t\n")
+                                     (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]"))
+                            ;; Skip over comments and labels following openbrace.
+                            (cond ((= (following-char) ?\#)
+                                   (forward-line 1))
+                                  ((= (following-char) ?\=)
+                                   (goto-char
+                                    (or (next-single-property-change (point) 'in-pod)
+                                        (point-max)))) ; do not loop if no syntaxification
+                                  ;; label:
+                                  (t
+                                   (save-excursion (end-of-line)
+                                                   (setq colon-line-end (point)))
+                                   (search-forward ":"))))
+                          ;; We are at beginning of code (NOT label or comment)
+                          ;; First, the following code counts
+                          ;; if it is before the line we want to indent.
+                          (and (< (point) indent-point)
+                               (vector 'have-prev-sibling (point) colon-line-end
+                                       containing-sexp))))
+                      (progn
+                        ;; If no previous statement,
+                        ;; indent it relative to line brace is on.
+
+                        ;; For open-braces not the first thing in a line,
+                        ;; add in cperl-brace-imaginary-offset.
+
+                        ;; If first thing on a line:  ?????
+                        ;; Move back over whitespace before the openbrace.
+                        (setq           ; brace first thing on a line
+                         old-indent (progn (skip-chars-backward " \t") (bolp)))
+                        ;; Should we indent w.r.t. earlier than start?
+                        ;; Move to start of control group, possibly on a different line
+                        (or cperl-indent-wrt-brace
+                            (cperl-backward-to-noncomment (point-min)))
+                        ;; If the openbrace is preceded by a parenthesized exp,
+                        ;; move to the beginning of that;
+                        (if (eq (preceding-char) ?\))
+                            (progn
+                              (forward-sexp -1)
+                              (cperl-backward-to-noncomment (point-min))))
+                        ;; In the case it starts a subroutine, indent with
+                        ;; respect to `sub', not with respect to the
+                        ;; first thing on the line, say in the case of
+                        ;; anonymous sub in a hash.
+                        (if (and;; Is it a sub in group starting on this line?
+                             (cond ((get-text-property (point) 'attrib-group)
+                                    (goto-char (cperl-beginning-of-property
+                                                (point) 'attrib-group)))
+                                   ((eq (preceding-char) ?b)
+                                    (forward-sexp -1)
+                                    (looking-at "sub\\>")))
+                             (setq p (nth 1 ; start of innermost containing list
+                                          (parse-partial-sexp
+                                           (save-excursion (beginning-of-line)
+                                                           (point))
+                                           (point)))))
+                            (progn
+                              (goto-char (1+ p)) ; enclosing block on the same line
+                              (skip-chars-forward " \t")
+                              (vector 'code-start-in-block containing-sexp char-after
+                                      (and delim (not is-block)) ; is a HASH
+                                      old-indent ; brace first thing on a line
+                                      t (point) ; have something before...
+                                      )
+                              ;;(current-column)
+                              )
+                          ;; Get initial indentation of the line we are on.
+                          ;; If line starts with label, calculate label indentation
+                          (vector 'code-start-in-block containing-sexp char-after
+                                  (and delim (not is-block)) ; is a HASH
+                                  old-indent ; brace first thing on a line
+                                  nil (point) ; nothing interesting before
+                                  ))))))))))))))
+
+(defvar cperl-indent-rules-alist
+  '((pod nil)                           ; via `syntax-type' property
+    (here-doc nil)                      ; via `syntax-type' property
+    (here-doc-delim nil)                ; via `syntax-type' property
+    (format nil)                        ; via `syntax-type' property
+    (in-pod nil)                        ; via `in-pod' property
+    (comment-special:at-beginning-of-line nil)
+    (string t)
+    (comment nil))
+  "Alist of indentation rules for CPerl mode.
+The values mean:
+  nil: do not indent;
+  number: add this amount of indentation.
+
+Not finished.")
+
+(defun cperl-calculate-indent (&optional parse-data) ; was parse-start
+  "Return appropriate indentation for current line as Perl code.
+In usual case returns an integer: the column to indent to.
+Returns nil if line starts inside a string, t if in a comment.
+
+Will not correct the indentation for labels, but will correct it for braces
+and closing parentheses and brackets."
+  ;; This code is still a broken architecture: in some cases we need to
+  ;; compensate for some modifications which `cperl-indent-line' will add later
+  (save-excursion
+    (let ((i (cperl-sniff-for-indent parse-data)) what p)
+      (cond
+       ;;((or (null i) (eq i t) (numberp i))
+       ;;  i)
+       ((vectorp i)
+        (setq what (assoc (elt i 0) cperl-indent-rules-alist))
+        (cond
+         (what (cadr what))             ; Load from table
+         ;;
+         ;; Indenters for regular expressions with //x and qw()
+         ;;
+         ((eq 'REx-part2 (elt i 0)) ;; [self start] start of /REP in s//REP/x
+          (goto-char (elt i 1))
+          (condition-case nil   ; Use indentation of the 1st part
+              (forward-sexp -1))
+          (current-column))
+         ((eq 'indentable (elt i 0))    ; Indenter for REGEXP qw() etc
+          (cond                ;;; [indentable terminator start-pos is-block]
+           ((eq 'terminator (elt i 1)) ; Lone terminator of "indentable string"
+            (goto-char (elt i 2))       ; After opening parens
+            (1- (current-column)))
+           ((eq 'first-line (elt i 1)); [indentable first-line start-pos]
+            (goto-char (elt i 2))
+            (+ (or cperl-regexp-indent-step cperl-indent-level)
+               -1
+               (current-column)))
+           ((eq 'cont-line (elt i 1)); [indentable cont-line pos prev-pos first-char start-pos]
+            ;; Indent as the level after closing parens
+            (goto-char (elt i 2))       ; indent line
+            (skip-chars-forward " \t)") ; Skip closing parens
+            (setq p (point))
+            (goto-char (elt i 3))       ; previous line
+            (skip-chars-forward " \t)") ; Skip closing parens
+            ;; Number of parens in between:
+            (setq p (nth 0 (parse-partial-sexp (point) p))
+                  what (elt i 4))       ; First char on current line
+            (goto-char (elt i 3))       ; previous line
+            (+ (* p (or cperl-regexp-indent-step cperl-indent-level))
+               (cond ((eq what ?\) )
+                      (- cperl-close-paren-offset)) ; compensate
+                     ((eq what ?\| )
+                      (- (or cperl-regexp-indent-step cperl-indent-level)))
+                     (t 0))
+               (if (eq (following-char) ?\| )
+                   (or cperl-regexp-indent-step cperl-indent-level)
+                 0)
+               (current-column)))
+           (t
+            (error "Unrecognized value of indent: %s" i))))
+         ;;
+         ;; Indenter for stuff at toplevel
+         ;;
+         ((eq 'toplevel (elt i 0)) ;; [toplevel start char-after state immed-after-block]
+          (+ (save-excursion            ; To beg-of-defun, or end of last sexp
+               (goto-char (elt i 1))    ; start = Good place to start parsing
+               (- (current-indentation) ; 
+                  (if (elt i 4) cperl-indent-level 0))) ; immed-after-block
+             (if (eq (elt i 2) ?{) cperl-continued-brace-offset 0) ; char-after
+             ;; Look at previous line that's at column 0
+             ;; to determine whether we are in top-level decls
+             ;; or function's arg decls.  Set basic-indent accordingly.
+             ;; Now add a little if this is a continuation line.
+             (if (elt i 3)              ; state (XXX What is the semantic???)
+                 0
+               cperl-continued-statement-offset)))
+         ;;
+         ;; Indenter for stuff in "parentheses" (or brackets, braces-as-hash)
+         ;;
+         ((eq 'in-parens (elt i 0))
+          ;; in-parens char-after old-indent-point is-brace containing-sexp
+
+          ;; group is an expression, not a block:
+          ;; indent to just after the surrounding open parens,
+          ;; skip blanks if we do not close the expression.
+          (+ (progn
+               (goto-char (elt i 2))            ; old-indent-point
+               (current-column))
+             (if (and (elt i 3)         ; is-brace
+                      (eq (elt i 1) ?\})) ; char-after
+                 ;; Correct indentation of trailing ?\}
+                 (+ cperl-indent-level cperl-close-paren-offset)
+               0)))
+         ;;
+         ;; Indenter for continuation lines
+         ;;
+         ((eq 'continuation (elt i 0))
+          ;; [continuation statement-start char-after is-block is-brace]
+          (goto-char (elt i 1))         ; statement-start
+          (+ (if (memq (elt i 2) (append "}])" nil)) ; char-after
+                 0                      ; Closing parenth
+               cperl-continued-statement-offset)
+             (if (or (elt i 3)          ; is-block
+                     (not (elt i 4))            ; is-brace
+                     (not (eq (elt i 2) ?\}))) ; char-after
+                 0
+               ;; Now it is a hash reference
+               (+ cperl-indent-level cperl-close-paren-offset))
+             ;; Labels do not take :: ...
+             (if (looking-at "\\(\\w\\|_\\)+[ \t]*:")
+                 (if (> (current-indentation) cperl-min-label-indent)
+                     (- (current-indentation) cperl-label-offset)
+                   ;; Do not move `parse-data', this should
+                   ;; be quick anyway (this comment comes
+                   ;; from different location):
+                   (cperl-calculate-indent))
+               (current-column))
+             (if (eq (elt i 2) ?\{)     ; char-after
+                 cperl-continued-brace-offset 0)))
+         ;;
+         ;; Indenter for lines in a block which are not leading lines
+         ;;
+         ((eq 'have-prev-sibling (elt i 0))
+          ;; [have-prev-sibling sibling-beg colon-line-end block-start]
+          (goto-char (elt i 1))
+          (if (> (elt i 2) (point)) ; colon-line-end; After-label, same line
+              (if (> (current-indentation)
+                     cperl-min-label-indent)
+                  (- (current-indentation) cperl-label-offset)
+                ;; Do not believe: `max' was involved in calculation of indent
+                (+ cperl-indent-level
+                   (save-excursion
+                     (goto-char (elt i 3)) ; block-start
+                     (current-indentation))))
+            (current-column)))
+         ;;
+         ;; Indenter for the first line in a block
+         ;;
+         ((eq 'code-start-in-block (elt i 0))
+          ;;[code-start-in-block before-brace char-after
+          ;; is-a-HASH-ref brace-is-first-thing-on-a-line
+          ;; group-starts-before-start-of-sub start-of-control-group]
+          (goto-char (elt i 1))
+          ;; For open brace in column zero, don't let statement
+          ;; start there too.  If cperl-indent-level=0,
+          ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
+          (+ (if (and (bolp) (zerop cperl-indent-level))
+                 (+ cperl-brace-offset cperl-continued-statement-offset)
+               cperl-indent-level)
+             (if (and (elt i 3) ; is-a-HASH-ref
+                      (eq (elt i 2) ?\})) ; char-after: End of a hash reference
+                 (+ cperl-indent-level cperl-close-paren-offset)
+               0)
+             ;; Unless openbrace is the first nonwhite thing on the line,
+             ;; add the cperl-brace-imaginary-offset.
+             (if (elt i 4) 0            ; brace-is-first-thing-on-a-line
+               cperl-brace-imaginary-offset)
+             (progn
+               (goto-char (elt i 6))    ; start-of-control-group
+               (if (elt i 5)            ; group-starts-before-start-of-sub
+                   (current-column)
+                 ;; Get initial indentation of the line we are on.
+                 ;; If line starts with label, calculate label indentation
+                 (if (save-excursion
+                       (beginning-of-line)
+                       (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
+                     (if (> (current-indentation) cperl-min-label-indent)
+                         (- (current-indentation) cperl-label-offset)
+                       ;; Do not move `parse-data', this should
+                       ;; be quick anyway:
+                       (cperl-calculate-indent))
+                   (current-indentation))))))
+         (t
+          (error "Unrecognized value of indent: %s" i))))
+       (t
+        (error "Got strange value of indent: %s" i))))))
+
+(defvar cperl-indent-alist
+  '((string nil)
+    (comment nil)
+    (toplevel 0)
+    (toplevel-after-parenth 2)
+    (toplevel-continued 2)
+    (expression 1))
+  "Alist of indentation rules for CPerl mode.
+The values mean:
+  nil: do not indent;
+  number: add this amount of indentation.
+
+Not finished, not used.")
+
+(defun cperl-where-am-i (&optional parse-start start-state)
+  ;; Unfinished
+  "Return a list of lists ((TYPE POS)...) of good points before the point.
+POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'.
+
+Not finished, not used."
+  (save-excursion
+    (let* ((start-point (point)) unused
+           (s-s (cperl-get-state))
+           (start (nth 0 s-s))
+           (state (nth 1 s-s))
+           (prestart (nth 3 s-s))
+           (containing-sexp (car (cdr state)))
+           (case-fold-search nil)
+           (res (list (list 'parse-start start) (list 'parse-prestart prestart))))
+      (cond ((nth 3 state)              ; In string
+             (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string
+            ((nth 4 state)              ; In comment
+             (setq res (cons '(comment) res)))
+            ((null containing-sexp)
+             ;; Line is at top level.
+             ;; Indent like the previous top level line
+             ;; unless that ends in a closeparen without semicolon,
+             ;; in which case this line is the first argument decl.
+             (cperl-backward-to-noncomment (or parse-start (point-min)))
+             ;;(skip-chars-backward " \t\f\n")
+             (cond
+              ((or (bobp)
+                   (memq (preceding-char) (append ";}" nil)))
+               (setq res (cons (list 'toplevel start) res)))
+              ((eq (preceding-char) ?\) )
+               (setq res (cons (list 'toplevel-after-parenth start) res)))
+              (t
+               (setq res (cons (list 'toplevel-continued start) res)))))
+            ((/= (char-after containing-sexp) ?{)
+             ;; line is expression, not statement:
+             ;; indent to just after the surrounding open.
+             ;; skip blanks if we do not close the expression.
+             (setq res (cons (list 'expression-blanks
+                                   (progn
+                                     (goto-char (1+ containing-sexp))
+                                     (or (looking-at "[ \t]*\\(#\\|$\\)")
+                                         (skip-chars-forward " \t"))
+                                     (point)))
+                             (cons (list 'expression containing-sexp) res))))
+            ((progn
+               ;; Containing-expr starts with \{.  Check whether it is a hash.
+               (goto-char containing-sexp)
+               (not (cperl-block-p)))
+             (setq res (cons (list 'expression-blanks
+                                   (progn
+                                     (goto-char (1+ containing-sexp))
+                                     (or (looking-at "[ \t]*\\(#\\|$\\)")
+                                         (skip-chars-forward " \t"))
+                                     (point)))
+                             (cons (list 'expression containing-sexp) res))))
+            (t
+             ;; Statement level.
+             (setq res (cons (list 'in-block containing-sexp) res))
+             ;; Is it a continuation or a new statement?
+             ;; Find previous non-comment character.
+             (cperl-backward-to-noncomment containing-sexp)
+             ;; Back up over label lines, since they don't
+             ;; affect whether our line is a continuation.
+             ;; Back up comma-delimited lines too ?????
+             (while (or (eq (preceding-char) ?\,)
+                        (save-excursion (cperl-after-label)))
+               (if (eq (preceding-char) ?\,)
+                   ;; Will go to beginning of line, essentially
+                   ;; Will ignore embedded sexpr XXXX.
+                   (cperl-backward-to-start-of-continued-exp containing-sexp))
+               (beginning-of-line)
+               (cperl-backward-to-noncomment containing-sexp))
+             ;; Now we get the answer.
+             (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\,
+                 ;; This line is continuation of preceding line's statement.
+                 (list (list 'statement-continued containing-sexp))
+               ;; This line starts a new statement.
+               ;; Position following last unclosed open.
+               (goto-char containing-sexp)
+               ;; Is line first statement after an open-brace?
+               (or
+                ;; If no, find that first statement and indent like
+                ;; it.  If the first statement begins with label, do
+                ;; not believe when the indentation of the label is too
+                ;; small.
+                (save-excursion
+                  (forward-char 1)
+                  (let ((colon-line-end 0))
+                    (while (progn (skip-chars-forward " \t\n" start-point)
+                                  (and (< (point) start-point)
+                                       (looking-at
+                                        "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))
+                      ;; Skip over comments and labels following openbrace.
+                      (cond ((= (following-char) ?\#)
+                             ;;(forward-line 1)
+                             (end-of-line))
+                            ;; label:
+                            (t
+                             (save-excursion (end-of-line)
+                                             (setq colon-line-end (point)))
+                             (search-forward ":"))))
+                    ;; Now at the point, after label, or at start
+                    ;; of first statement in the block.
+                    (and (< (point) start-point)
+                         (if (> colon-line-end (point))
+                             ;; Before statement after label
+                             (if (> (current-indentation)
+                                    cperl-min-label-indent)
+                                 (list (list 'label-in-block (point)))
+                               ;; Do not believe: `max' is involved
+                               (list
+                                (list 'label-in-block-min-indent (point))))
+                           ;; Before statement
+                           (list 'statement-in-block (point))))))
+                ;; If no previous statement,
+                ;; indent it relative to line brace is on.
+                ;; For open brace in column zero, don't let statement
+                ;; start there too.  If cperl-indent-level is zero,
+                ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
+                ;; For open-braces not the first thing in a line,
+                ;; add in cperl-brace-imaginary-offset.
+
+                ;; If first thing on a line:  ?????
+                (setq unused            ; This is not finished...
+                (+ (if (and (bolp) (zerop cperl-indent-level))
+                       (+ cperl-brace-offset cperl-continued-statement-offset)
+                     cperl-indent-level)
+                   ;; Move back over whitespace before the openbrace.
+                   ;; If openbrace is not first nonwhite thing on the line,
+                   ;; add the cperl-brace-imaginary-offset.
+                   (progn (skip-chars-backward " \t")
+                          (if (bolp) 0 cperl-brace-imaginary-offset))
+                   ;; If the openbrace is preceded by a parenthesized exp,
+                   ;; move to the beginning of that;
+                   ;; possibly a different line
+                   (progn
+                     (if (eq (preceding-char) ?\))
+                         (forward-sexp -1))
+                     ;; Get initial indentation of the line we are on.
+                     ;; If line starts with label, calculate label indentation
+                     (if (save-excursion
+                           (beginning-of-line)
+                           (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
+                         (if (> (current-indentation) cperl-min-label-indent)
+                             (- (current-indentation) cperl-label-offset)
+                           (cperl-calculate-indent))
+                       (current-indentation)))))))))
+      res)))
 
 (defun cperl-calculate-indent-within-comment ()
   "Return the indentation amount for line, assuming that
@@ -2894,14 +3350,22 @@ the current line is to be regarded as part of a block comment."
 
 (defun cperl-to-comment-or-eol ()
   "Go to position before comment on the current line, or to end of line.
-Returns true if comment is found."
-  (let (state stop-in cpoint (lim (progn (end-of-line) (point))))
+Returns true if comment is found.  In POD will not move the point."
+  ;; If the line is inside other syntax groups (qq-style strings, HERE-docs)
+  ;; then looks for literal # or end-of-line.
+  (let (state stop-in cpoint (lim (progn (end-of-line) (point))) pr e)
+    (or cperl-font-locking
+        (cperl-update-syntaxification lim lim))
     (beginning-of-line)
-    (if (or
-         (eq (get-text-property (point) 'syntax-type) 'pod)
-         (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t))
+    (if (setq pr (get-text-property (point) 'syntax-type))
+        (setq e (next-single-property-change (point) 'syntax-type nil (point-max))))
+    (if (or (eq pr 'pod)
+            (if (or (not e) (> e lim))  ; deep inside a group
+                (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)))
         (if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
-      ;; Else
+      ;; Else - need to do it the hard way
+      (and (and e (<= e lim))
+           (goto-char e))
       (while (not stop-in)
         (setq state (parse-partial-sexp (point) lim nil nil nil t))
                                         ; stop at comment
@@ -2933,17 +3397,11 @@ Returns true if comment is found."
           (setq stop-in t)))            ; Finish
       (nth 4 state))))
 
-(defsubst cperl-1- (p)
-  (max (point-min) (1- p)))
-
-(defsubst cperl-1+ (p)
-  (min (point-max) (1+ p)))
-
 (defsubst cperl-modify-syntax-type (at how)
   (if (< at (point-max))
       (progn
         (put-text-property at (1+ at) 'syntax-table how)
-        (put-text-property at (1+ at) 'rear-nonsticky t))))
+        (put-text-property at (1+ at) 'rear-nonsticky '(syntax-table)))))
 
 (defun cperl-protect-defun-start (s e)
   ;; C code looks for "^\\s(" to skip comment backward in "hard" situations
@@ -2978,35 +3436,53 @@ Returns true if comment is found."
                          ( ?\{ . ?\} )
                          ( ?\< . ?\> )))
 
-(defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument
+(defun cperl-cached-syntax-table (st)
+  "Get a syntax table cached in ST, or create and cache into ST a syntax table.
+All the entries of the syntax table are \".\", except for a backslash, which
+is quoting."
+  (if (car-safe st)
+      (car st)
+    (setcar st (make-syntax-table))
+    (setq st (car st))
+    (let ((i 0))
+      (while (< i 256)
+        (modify-syntax-entry i "." st)
+        (setq i (1+ i))))
+    (modify-syntax-entry ?\\ "\\" st)
+    st))
+
+(defun cperl-forward-re (lim end is-2arg st-l err-l argument
                              &optional ostart oend)
-  ;; Works *before* syntax recognition is done
-  ;; May modify syntax-type text property if the situation is too hard
-  (let (b starter ender st i i2 go-forward reset-st)
+"Find the end of a regular expression or a stringish construct (q[] etc).
+The point should be before the starting delimiter.
+
+Goes to LIM if none is found.  If IS-2ARG is non-nil, assumes that it
+is s/// or tr/// like expression.  If END is nil, generates an error
+message if needed.  If SET-ST is non-nil, will use (or generate) a
+cached syntax table in ST-L.  If ERR-L is non-nil, will store the
+error message in its CAR (unless it already contains some error
+message).  ARGUMENT should be the name of the construct (used in error
+messages).  OSTART, OEND may be set in recursive calls when processing
+the second argument of 2ARG construct.
+
+Works *before* syntax recognition is done.  In IS-2ARG situation may
+modify syntax-type text property if the situation is too hard."
+  (let (b starter ender st i i2 go-forward reset-st set-st)
     (skip-chars-forward " \t")
     ;; ender means matching-char matcher.
     (setq b (point)
           starter (if (eobp) 0 (char-after b))
           ender (cdr (assoc starter cperl-starters)))
     ;; What if starter == ?\\  ????
-    (if set-st
-        (if (car st-l)
-            (setq st (car st-l))
-          (setcar st-l (make-syntax-table))
-          (setq i 0 st (car st-l))
-          (while (< i 256)
-            (modify-syntax-entry i "." st)
-            (setq i (1+ i)))
-          (modify-syntax-entry ?\\ "\\" st)))
+    (setq st (cperl-cached-syntax-table st-l))
     (setq set-st t)
     ;; Whether we have an intermediate point
     (setq i nil)
     ;; Prepare the syntax table:
-    (and set-st
-         (if (not ender)                ; m/blah/, s/x//, s/x/y/
-             (modify-syntax-entry starter "$" st)
-           (modify-syntax-entry starter (concat "(" (list ender)) st)
-           (modify-syntax-entry ender  (concat ")" (list starter)) st)))
+    (if (not ender)             ; m/blah/, s/x//, s/x/y/
+        (modify-syntax-entry starter "$" st)
+      (modify-syntax-entry starter (concat "(" (list ender)) st)
+      (modify-syntax-entry ender  (concat ")" (list starter)) st))
     (condition-case bb
         (progn
           ;; We use `$' syntax class to find matching stuff, but $$
@@ -3053,7 +3529,7 @@ Returns true if comment is found."
                 (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
                 (if ender (modify-syntax-entry ender "." st))
                 (setq set-st nil)
-                (setq ender (cperl-forward-re lim end nil t st-l err-l
+                (setq ender (cperl-forward-re lim end nil st-l err-l
                                               argument starter ender)
                  ender (nth 2 ender)))))
       (error (goto-char lim)
@@ -3078,6 +3554,33 @@ Returns true if comment is found."
     ;; go-forward: has 2 args, and the second part is empty
     (list i i2 ender starter go-forward)))
 
+(defun cperl-forward-group-in-re (&optional st-l)
+  "Find the end of a group in a REx.
+Return the error message (if any).  Does not work if delimiter is `)'.
+Works before syntax recognition is done."
+  ;; Works *before* syntax recognition is done
+  (or st-l (setq st-l (list nil)))      ; Avoid overwriting '()
+  (let (st b reset-st)
+    (condition-case b
+        (progn
+          (setq st (cperl-cached-syntax-table st-l))
+          (modify-syntax-entry ?\( "()" st)
+          (modify-syntax-entry ?\) ")(" st)
+          (setq reset-st (syntax-table))
+          (set-syntax-table st)
+          (forward-sexp 1))
+      (error (message
+              "cperl-forward-group-in-re: error %s" b)))
+    ;; now restore the initial state
+    (if st
+        (progn
+          (modify-syntax-entry ?\( "." st)
+          (modify-syntax-entry ?\) "." st)))
+    (if reset-st
+        (set-syntax-table reset-st))
+    b))
+
+
 (defvar font-lock-string-face)
 ;;(defvar font-lock-reference-face)
 (defvar font-lock-constant-face)
@@ -3103,13 +3606,24 @@ Returns true if comment is found."
 ;;      d) 'Q'uoted string:
 ;;              part between markers inclusive is marked `syntax-type' ==> `string'
 ;;              part between `q' and the first marker is marked `syntax-type' ==> `prestring'
+;;              second part of s///e is marked `syntax-type' ==> `multiline'
+;;      e) Attributes of subroutines: `attrib-group' ==> t
+;;              (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'.
+;;      f) Multiline my/our declaration lists etc: `syntax-type' => `multiline'
+
+;;; In addition, some parts of RExes may be marked as `REx-interpolated'
+;;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise).
 
 (defun cperl-unwind-to-safe (before &optional end)
   ;; if BEFORE, go to the previous start-of-line on each step of unwinding
   (let ((pos (point)) opos)
-    (setq opos pos)
-    (while (and pos (get-text-property pos 'syntax-type))
-      (setq pos (previous-single-property-change pos 'syntax-type))
+    (while (and pos (progn
+                      (beginning-of-line)
+                      (get-text-property (setq pos (point)) 'syntax-type)))
+      (setq opos pos
+            pos (cperl-beginning-of-property pos 'syntax-type))
+      (if (eq pos (point-min))
+          (setq pos nil))
       (if pos
           (if before
               (progn
@@ -3126,32 +3640,117 @@ Returns true if comment is found."
     (setq pos (point))
     (if end
         ;; Do the same for end, going small steps
-        (progn
+        (save-excursion
           (while (and end (get-text-property end 'syntax-type))
             (setq pos end
-                  end (next-single-property-change end 'syntax-type)))
+                  end (next-single-property-change end 'syntax-type nil (point-max)))
+            (if end (progn (goto-char end)
+                           (or (bolp) (forward-line 1))
+                           (setq end (point)))))
           (or end pos)))))
 
+;;; These are needed for byte-compile (at least with v19)
 (defvar cperl-nonoverridable-face)
+(defvar font-lock-variable-name-face)
 (defvar font-lock-function-name-face)
+(defvar font-lock-keyword-face)
+(defvar font-lock-builtin-face)
+(defvar font-lock-type-face)
 (defvar font-lock-comment-face)
+(defvar font-lock-warning-face)
 
-(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max)
+(defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
+  "Syntaxically mark (and fontify) attributes of a subroutine.
+Should be called with the point before leading colon of an attribute."
+  ;; Works *before* syntax recognition is done
+  (or st-l (setq st-l (list nil)))      ; Avoid overwriting '()
+  (let (st b p reset-st after-first (start (point)) start1 end1)
+    (condition-case b
+        (while (looking-at
+                (concat
+                 "\\("                  ; 1=optional? colon
+                   ":" cperl-maybe-white-and-comment-rex ; 2=whitespace/comment?
+                 "\\)"
+                 (if after-first "?" "")
+                 ;; No space between name and paren allowed...
+                 "\\(\\sw+\\)"          ; 3=name
+                 "\\((\\)?"))           ; 4=optional paren
+          (and (match-beginning 1)
+               (cperl-postpone-fontification
+                (match-beginning 0) (cperl-1+ (match-beginning 0))
+                'face font-lock-constant-face))
+          (setq start1 (match-beginning 3) end1 (match-end 3))
+          (cperl-postpone-fontification start1 end1
+                                        'face font-lock-constant-face)
+          (goto-char end1)              ; end or before `('
+          (if (match-end 4)             ; Have attribute arguments...
+              (progn
+                (if st nil
+                  (setq st (cperl-cached-syntax-table st-l))
+                  (modify-syntax-entry ?\( "()" st)
+                  (modify-syntax-entry ?\) ")(" st))
+                (setq reset-st (syntax-table) p (point))
+                (set-syntax-table st)
+                (forward-sexp 1)
+                (set-syntax-table reset-st)
+                (setq reset-st nil)
+                (cperl-commentify p (point) t))) ; mark as string
+          (forward-comment (buffer-size))
+          (setq after-first t))
+      (error (message
+              "L%d: attribute `%s': %s"
+              (count-lines (point-min) (point))
+              (and start1 end1 (buffer-substring start1 end1)) b)
+             (setq start nil)))
+    (and start
+         (progn
+           (put-text-property start (point)
+                              'attrib-group (if (looking-at "{") t 0))
+           (and pos
+                (< 1 (count-lines (+ 3 pos) (point))) ; end of `sub'
+                ;; Apparently, we do not need `multiline': faces added now
+                (put-text-property (+ 3 pos) (cperl-1+ (point))
+                                   'syntax-type 'sub-decl))
+           (and b-fname                 ; Fontify here: the following condition
+                (cperl-postpone-fontification ; is too hard to determine by
+                 b-fname e-fname 'face ; a REx, so do it here
+                (if (looking-at "{")
+                    font-lock-function-name-face
+                  font-lock-variable-name-face)))))
+    ;; now restore the initial state
+    (if st
+        (progn
+          (modify-syntax-entry ?\( "." st)
+          (modify-syntax-entry ?\) "." st)))
+    (if reset-st
+        (set-syntax-table reset-st))))
+
+(defsubst cperl-look-at-leading-count (is-x-REx e)
+  (if (re-search-forward (concat "\\=" (if is-x-REx "[ \t\n]*" "") "[{?+*]")
+                         (1- e) t)      ; return nil on failure, no moving
+      (if (eq ?\{ (preceding-char)) nil
+        (cperl-postpone-fontification
+         (1- (point)) (point)
+         'face font-lock-warning-face))))
+
+;;; Debugging this may require (setq max-specpdl-size 2000)...
+(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc)
   "Scans the buffer for hard-to-parse Perl constructions.
 If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
 the sections using `cperl-pod-head-face', `cperl-pod-face',
 `cperl-here-face'."
   (interactive)
-  (or min (setq min (point-min)
+ (or min (setq min (point-min)
                 cperl-syntax-state nil
                 cperl-syntax-done-to min))
   (or max (setq max (point-max)))
   (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
          face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
-         is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2
+         is-REx is-x-REx REx-subgr-start REx-subgr-end was-subgr i2 hairy-RE
          (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
-         (modified (buffer-modified-p))
+         (modified (buffer-modified-p)) overshoot is-o-REx
          (after-change-functions nil)
+         (cperl-font-locking t)
          (use-syntax-state (and cperl-syntax-state
                                 (>= min (car cperl-syntax-state))))
          (state-point (if use-syntax-state
@@ -3162,33 +3761,62 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
          ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call!
          (st-l (list nil)) (err-l (list nil))
          ;; Somehow font-lock may be not loaded yet...
+         ;; (e.g., when building TAGS via command-line call)
          (font-lock-string-face (if (boundp 'font-lock-string-face)
                                     font-lock-string-face
                                   'font-lock-string-face))
-         (font-lock-constant-face (if (boundp 'font-lock-constant-face)
+         (my-cperl-delimiters-face (if (boundp 'font-lock-constant-face)
                                       font-lock-constant-face
                                     'font-lock-constant-face))
-         (font-lock-function-name-face
+         (my-cperl-REx-spec-char-face   ; [] ^.$ and wrapper-of ({})
           (if (boundp 'font-lock-function-name-face)
               font-lock-function-name-face
             'font-lock-function-name-face))
+         (font-lock-variable-name-face  ; interpolated vars and ({})-code
+          (if (boundp 'font-lock-variable-name-face)
+              font-lock-variable-name-face
+            'font-lock-variable-name-face))
+         (font-lock-function-name-face  ; used in `cperl-find-sub-attrs'
+          (if (boundp 'font-lock-function-name-face)
+              font-lock-function-name-face
+            'font-lock-function-name-face))
+         (font-lock-constant-face       ; used in `cperl-find-sub-attrs'
+          (if (boundp 'font-lock-constant-face)
+              font-lock-constant-face
+            'font-lock-constant-face))
+         (my-cperl-REx-0length-face ; 0-length, (?:)etc, non-literal \
+          (if (boundp 'font-lock-builtin-face)
+              font-lock-builtin-face
+            'font-lock-builtin-face))
          (font-lock-comment-face
           (if (boundp 'font-lock-comment-face)
               font-lock-comment-face
             'font-lock-comment-face))
-         (cperl-nonoverridable-face
+         (font-lock-warning-face
+          (if (boundp 'font-lock-warning-face)
+              font-lock-warning-face
+            'font-lock-warning-face))
+         (my-cperl-REx-ctl-face         ; (|)
+          (if (boundp 'font-lock-keyword-face)
+              font-lock-keyword-face
+            'font-lock-keyword-face))
+         (my-cperl-REx-modifiers-face   ; //gims
           (if (boundp 'cperl-nonoverridable-face)
               cperl-nonoverridable-face
-            'cperl-nonoverridable))
+            'cperl-nonoverridable-face))
+         (my-cperl-REx-length1-face     ; length=1 escaped chars, POSIX classes
+          (if (boundp 'font-lock-type-face)
+              font-lock-type-face
+            'font-lock-type-face))
          (stop-point (if ignore-max
                          (point-max)
                        max))
          (search
           (concat
-           "\\(\\`\n?\\|^\n\\)="
+           "\\(\\`\n?\\|^\n\\)="        ; POD
            "\\|"
            ;; One extra () before this:
-           "<<"
+           "<<"                         ; HERE-DOC
            "\\("                        ; 1 + 1
            ;; First variant "BLAH" or just ``.
            "[ \t]*"                     ; Yes, whitespace is allowed!
@@ -3204,36 +3832,44 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
            "\\)"
            "\\|"
            ;; 1+6 extra () before this:
-           "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
+           "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" ;FRMAT
            (if cperl-use-syntax-table-text-property
                (concat
                 "\\|"
                 ;; 1+6+2=9 extra () before this:
-                "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
+                "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ; QUOTED CONSTRUCT
                 "\\|"
                 ;; 1+6+2+1=10 extra () before this:
                 "\\([?/<]\\)"   ; /blah/ or ?blah? or <file*glob>
                 "\\|"
-                ;; 1+6+2+1+1=11 extra () before this:
-                "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"
+                ;; 1+6+2+1+1=11 extra () before this
+                "\\<sub\\>"             ;  sub with proto/attr
+                "\\("
+                   cperl-white-and-comment-rex
+                   "\\(::[a-zA-Z_:'0-9]*\\|[a-zA-Z_'][a-zA-Z_:'0-9]*\\)\\)?" ; name
+                "\\("
+                   cperl-maybe-white-and-comment-rex
+                   "\\(([^()]*)\\|:[^:]\\)\\)" ; prototype or attribute start
                 "\\|"
-                ;; 1+6+2+1+1+2=13 extra () before this:
-                "\\$\\(['{]\\)"
+                ;; 1+6+2+1+1+6=17 extra () before this:
+                "\\$\\(['{]\\)"         ; $' or ${foo}
                 "\\|"
-                ;; 1+6+2+1+1+2+1=14 extra () before this:
+                ;; 1+6+2+1+1+6+1=18 extra () before this (old pack'var syntax;
+                ;; we do not support intervening comments...):
                 "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"
-                ;; 1+6+2+1+1+2+1+1=15 extra () before this:
+                ;; 1+6+2+1+1+6+1+1=19 extra () before this:
                 "\\|"
-                "__\\(END\\|DATA\\)__"
-                ;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
+                "__\\(END\\|DATA\\)__"  ; __END__ or __DATA__
+                ;; 1+6+2+1+1+6+1+1+1=20 extra () before this:
                 "\\|"
-                "\\\\\\(['`\"($]\\)")
+                "\\\\\\(['`\"($]\\)")   ; BACKWACKED something-hairy
              ""))))
     (unwind-protect
         (progn
           (save-excursion
             (or non-inter
                 (message "Scanning for \"hard\" Perl constructions..."))
+            ;;(message "find: %s --> %s" min max)
             (and cperl-pod-here-fontify
                  ;; We had evals here, do not know why...
                  (setq face cperl-pod-face
@@ -3241,16 +3877,22 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                        here-face cperl-here-face))
             (remove-text-properties min max
                                     '(syntax-type t in-pod t syntax-table t
+                                                  attrib-group t
+                                                  REx-interpolated t
                                                   cperl-postpone t
                                                   syntax-subtype t
                                                   rear-nonsticky t
+                                                  front-sticky t
                                                   here-doc-group t
                                                   first-format-line t
+                                                  REx-part2 t
                                                   indentable t))
             ;; Need to remove face as well...
             (goto-char min)
             (and (eq system-type 'emx)
-                 (looking-at "extproc[ \t]") ; Analogue of #!
+                 (eq (point) 1)
+                 (let ((case-fold-search t))
+                   (looking-at "extproc[ \t]")) ; Analogue of #!
                  (cperl-commentify min
                                    (save-excursion (end-of-line) (point))
                                    nil))
@@ -3258,11 +3900,38 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                     (< (point) max)
                     (re-search-forward search max t))
               (setq tmpend nil)         ; Valid for most cases
+              (setq b (match-beginning 0)
+                    state (save-excursion (parse-partial-sexp
+                                           state-point b nil nil state))
+                    state-point b)
               (cond
+               ;; 1+6+2+1+1+6=17 extra () before this:
+               ;;    "\\$\\(['{]\\)"
+               ((match-beginning 18) ; $' or ${foo}
+                (if (eq (preceding-char) ?\') ; $'
+                    (progn
+                      (setq b (1- (point))
+                            state (parse-partial-sexp
+                                   state-point (1- b) nil nil state)
+                            state-point (1- b))
+                      (if (nth 3 state) ; in string
+                          (cperl-modify-syntax-type (1- b) cperl-st-punct))
+                      (goto-char (1+ b)))
+                  ;; else: ${
+                  (setq bb (match-beginning 0))
+                  (cperl-modify-syntax-type bb cperl-st-punct)))
+               ;; No processing in strings/comments beyond this point:
+               ((or (nth 3 state) (nth 4 state))
+                t)                      ; Do nothing in comment/string
                ((match-beginning 1)     ; POD section
                 ;;  "\\(\\`\n?\\|^\n\\)="
-                (if (looking-at "cut\\>")
-                    (if ignore-max
+                (setq b (match-beginning 0)
+                      state (parse-partial-sexp
+                             state-point b nil nil state)
+                      state-point b)
+                (if (or (nth 3 state) (nth 4 state)
+                        (looking-at "cut\\>"))
+                    (if (or (nth 3 state) (nth 4 state) ignore-max)
                         nil             ; Doing a chunk only
                       (message "=cut is not preceded by a POD section")
                       (or (car err-l) (setcar err-l (point))))
@@ -3288,11 +3957,15 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                        (progn
                          (remove-text-properties
                           max e '(syntax-type t in-pod t syntax-table t
+                                              attrib-group t
+                                              REx-interpolated t
                                               cperl-postpone t
                                               syntax-subtype t
                                               here-doc-group t
                                               rear-nonsticky t
+                                              front-sticky t
                                               first-format-line t
+                                              REx-part2 t
                                               indentable t))
                          (setq tmpend tb)))
                   (put-text-property b e 'in-pod t)
@@ -3335,7 +4008,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                   (or (eq e (point-max))
                       (forward-char -1)))) ; Prepare for immediate POD start.
                ;; Here document
-               ;; We do only one here-per-line
+               ;; We can do many here-per-line;
+               ;; but multiline quote on the same line as <<HERE confuses us...
                ;; ;; One extra () before this:
                ;;"<<"
                ;;  "\\("                        ; 1 + 1
@@ -3352,21 +4026,42 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                ;;    "\\(\\)"           ; To preserve count of pars :-( 6 + 1
                ;;  "\\)"
                ((match-beginning 2)     ; 1 + 1
-                ;; Abort in comment:
-                (setq b (point))
-                (setq state (parse-partial-sexp state-point b nil nil state)
-                      state-point b
+                (setq b (point)
                       tb (match-beginning 0)
-                      i (or (nth 3 state) (nth 4 state)))
-                (if i
-                    (setq c t)
-                  (setq c (and
-                           (match-beginning 5)
-                           (not (match-beginning 6)) ; Empty
-                           (looking-at
-                            "[ \t]*[=0-9$@%&(]"))))
+                      c (and            ; not HERE-DOC
+                         (match-beginning 5)
+                         (save-match-data
+                           (or (looking-at "[ \t]*(") ; << function_call()
+                               (save-excursion ; 1 << func_name, or $foo << 10
+                                 (condition-case nil
+                                     (progn
+                                       (goto-char tb)
+               ;;; XXX What to do: foo <<bar ???
+               ;;; XXX Need to support print {a} <<B ???
+                                       (forward-sexp -1)
+                                       (save-match-data 
+                                        ; $foo << b; $f .= <<B;
+                                        ; ($f+1) << b; a($f) . <<B;
+                                        ; foo 1, <<B; $x{a} <<b;
+                                         (cond
+                                          ((looking-at "[0-9$({]")
+                                           (forward-sexp 1)
+                                           (and
+                                            (looking-at "[ \t]*<<")
+                                            (condition-case nil
+                                                ;; print $foo <<EOF
+                                                (progn
+                                                  (forward-sexp -2)
+                                                  (not
+                                                   (looking-at "\\(printf?\\|system\\|exec\\|sort\\)\\>")))
+                                                (error t)))))))
+                                   (error nil))) ; func(<<EOF)
+                               (and (not (match-beginning 6)) ; Empty
+                                    (looking-at
+                                     "[ \t]*[=0-9$@%&(]"))))))
                 (if c                   ; Not here-doc
                     nil                 ; Skip it.
+                  (setq c (match-end 2)) ; 1 + 1
                   (if (match-beginning 5) ;4 + 1
                       (setq b1 (match-beginning 5) ; 4 + 1
                             e1 (match-end 5)) ; 4 + 1
@@ -3376,15 +4071,20 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                         qtag (regexp-quote tag))
                   (cond (cperl-pod-here-fontify
                          ;; Highlight the starting delimiter
-                         (cperl-postpone-fontification b1 e1 'face font-lock-constant-face)
+                         (cperl-postpone-fontification 
+                          b1 e1 'face my-cperl-delimiters-face)
                          (cperl-put-do-not-fontify b1 e1 t)))
                   (forward-line)
+                  (setq i (point))
+                  (if end-of-here-doc
+                      (goto-char end-of-here-doc))
                   (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 "$")
                                               stop-point 'toend)
-                           (eq (following-char) ?\n))
+                           ;;;(eq (following-char) ?\n) ; XXXX WHY???
+                           )
                     (progn              ; Pretend we matched at the end
                       (goto-char (point-max))
                       (re-search-forward "\\'")
@@ -3393,8 +4093,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                   (if cperl-pod-here-fontify
                       (progn
                         ;; Highlight the ending delimiter
-                        (cperl-postpone-fontification (match-beginning 0) (match-end 0)
-                                                      'face font-lock-constant-face)
+                        (cperl-postpone-fontification
+                         (match-beginning 0) (match-end 0)
+                         'face my-cperl-delimiters-face)
                         (cperl-put-do-not-fontify b (match-end 0) t)
                         ;; Highlight the HERE-DOC
                         (cperl-postpone-fontification b (match-beginning 0)
@@ -3404,10 +4105,21 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                      'syntax-type 'here-doc)
                   (put-text-property (match-beginning 0) e1
                                      'syntax-type 'here-doc-delim)
-                  (put-text-property b e1
-                                     'here-doc-group t)
+                  (put-text-property b e1 'here-doc-group t)
+                  ;; This makes insertion at the start of HERE-DOC update
+                  ;; the whole construct:
+                  (put-text-property b (cperl-1+ b) 'front-sticky '(syntax-type))
                   (cperl-commentify b e1 nil)
                   (cperl-put-do-not-fontify b (match-end 0) t)
+                  ;; Cache the syntax info...
+                  (setq cperl-syntax-state (cons state-point state))
+                  ;; ... and process the rest of the line...
+                  (setq overshoot
+                        (elt            ; non-inter ignore-max
+                         (cperl-find-pods-heres c i t end t e1) 1))
+                  (if (and overshoot (> overshoot (point)))
+                      (goto-char overshoot)
+                    (setq overshoot e1))
                   (if (> e1 max)
                       (setq tmpend tb))))
                ;; format
@@ -3462,7 +4174,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                 (if (> (point) max)
                     (setq tmpend tb))
                 (put-text-property b (point) 'syntax-type 'format))
-               ;; Regexp:
+               ;; qq-like String or Regexp:
                ((or (match-beginning 10) (match-beginning 11))
                 ;; 1+6+2=9 extra () before this:
                 ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
@@ -3471,10 +4183,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                 (setq b1 (if (match-beginning 10) 10 11)
                       argument (buffer-substring
                                 (match-beginning b1) (match-end b1))
-                      b (point)
+                      b (point)         ; end of qq etc
                       i b
                       c (char-after (match-beginning b1))
-                      bb (char-after (1- (match-beginning b1))) ; tmp holder
+                      bb (char-after (1- (match-beginning b1))) ; tmp holder
                       ;; bb == "Not a stringy"
                       bb (if (eq b1 10) ; user variables/whatever
                              (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
@@ -3488,7 +4200,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                               (- (match-beginning b1) 2))
                                              ?\-))
                                         ((eq bb ?\&)
-                                         (not (eq (char-after   ; &&m/blah/
+                                         (not (eq (char-after ; &&m/blah/
                                                    (- (match-beginning b1) 2))
                                                   ?\&)))
                                         (t t)))
@@ -3506,41 +4218,40 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                         (setq argument ""
                               b1 nil
                               bb        ; Not a regexp?
-                              (progn
-                                (not
-                                 ;; What is below: regexp-p?
-                                 (and
-                                  (or (memq (preceding-char)
-                                            (append (if (memq c '(?\? ?\<))
-                                                        ;; $a++ ? 1 : 2
-                                                        "~{(=|&*!,;:"
-                                                      "~{(=|&+-*!,;:") nil))
-                                      (and (eq (preceding-char) ?\})
-                                           (cperl-after-block-p (point-min)))
-                                      (and (eq (char-syntax (preceding-char)) ?w)
-                                           (progn
-                                             (forward-sexp -1)
+                              (not
+                               ;; What is below: regexp-p?
+                               (and
+                                (or (memq (preceding-char)
+                                          (append (if (memq c '(?\? ?\<))
+                                                      ;; $a++ ? 1 : 2
+                                                      "~{(=|&*!,;:["
+                                                    "~{(=|&+-*!,;:[") nil))
+                                    (and (eq (preceding-char) ?\})
+                                         (cperl-after-block-p (point-min)))
+                                    (and (eq (char-syntax (preceding-char)) ?w)
+                                         (progn
+                                           (forward-sexp -1)
 ;; After these keywords `/' starts a RE.  One should add all the
 ;; functions/builtins which expect an argument, but ...
-                                             (if (eq (preceding-char) ?-)
-                                                 ;; -d ?foo? is a RE
-                                                 (looking-at "[a-zA-Z]\\>")
-                                               (and
-                                                (not (memq (preceding-char)
-                                                           '(?$ ?@ ?& ?%)))
-                                                (looking-at
-                                                 "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))))
-                                      (and (eq (preceding-char) ?.)
-                                           (eq (char-after (- (point) 2)) ?.))
-                                      (bobp))
-                                  ;;  m|blah| ? foo : bar;
-                                  (not
-                                   (and (eq c ?\?)
-                                        cperl-use-syntax-table-text-property
-                                        (not (bobp))
-                                        (progn
-                                          (forward-char -1)
-                                          (looking-at "\\s|")))))))
+                                           (if (eq (preceding-char) ?-)
+                                               ;; -d ?foo? is a RE
+                                               (looking-at "[a-zA-Z]\\>")
+                                             (and
+                                              (not (memq (preceding-char)
+                                                         '(?$ ?@ ?& ?%)))
+                                              (looking-at
+                                               "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))))
+                                    (and (eq (preceding-char) ?.)
+                                         (eq (char-after (- (point) 2)) ?.))
+                                    (bobp))
+                                ;;  m|blah| ? foo : bar;
+                                (not
+                                 (and (eq c ?\?)
+                                      cperl-use-syntax-table-text-property
+                                      (not (bobp))
+                                      (progn
+                                        (forward-char -1)
+                                        (looking-at "\\s|"))))))
                               b (1- b))
                       ;; s y tr m
                       ;; Check for $a -> y
@@ -3550,13 +4261,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                (eq (char-after (- go 2)) ?-))
                           ;; Not a regexp
                           (setq bb t))))
-                (or bb (setq state (parse-partial-sexp
-                                    state-point b nil nil state)
-                             state-point b))
-                (setq bb (or bb (nth 3 state) (nth 4 state)))
-                (goto-char b)
                 (or bb
                     (progn
+                      (goto-char b)
                       (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
                           (goto-char (match-end 0))
                         (skip-chars-forward " \t\n\f"))
@@ -3593,6 +4300,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                     (skip-chars-backward " \t\n\f")
                                     (memq (preceding-char)
                                           (append "$@%&*" nil))))
+                             (setq bb t))
+                            ((eobp)
                              (setq bb t)))))
                 (if bb
                     (goto-char i)
@@ -3605,15 +4314,16 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                   ;; qtag means two-arg matcher, may be reset to
                   ;;   2 or 3 later if some special quoting is needed.
                   ;; e1 means matching-char matcher.
-                  (setq b (point)
+                  (setq b (point)       ; before the first delimiter
                         ;; has 2 args
                         i2 (string-match "^\\([sy]\\|tr\\)$" argument)
                         ;; We do not search to max, since we may be called from
                         ;; some hook of fontification, and max is random
                         i (cperl-forward-re stop-point end
                                             i2
-                                            t st-l err-l argument)
-                        ;; Note that if `go', then it is considered as 1-arg
+                                            st-l err-l argument)
+                        ;; If `go', then it is considered as 1-arg, `b1' is nil
+                        ;; as in s/foo//x; the point is before final "slash"
                         b1 (nth 1 i)    ; start of the second part
                         tag (nth 2 i)   ; ender-char, true if second part
                                         ; is with matching chars []
@@ -3625,13 +4335,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                  (1- e1))
                         e (if i i e1)   ; end of the first part
                         qtag nil        ; need to preserve backslashitis
-                        is-x-REx nil)   ; REx has //x modifier
+                        is-x-REx nil is-o-REx nil); REx has //x //o modifiers
+                  ;; If s{} (), then b/b1 are at "{", "(", e1/i after ")", "}"
                   ;; Commenting \\ is dangerous, what about ( ?
                   (and i tail
                        (eq (char-after i) ?\\)
                        (setq qtag t))
-                  (if (looking-at "\\sw*x") ; qr//x
-                      (setq is-x-REx t))
+                  (and (if go (looking-at ".\\sw*x")
+                         (looking-at "\\sw*x")) ; qr//x
+                       (setq is-x-REx t))
+                  (and (if go (looking-at ".\\sw*o")
+                         (looking-at "\\sw*o")) ; //o
+                       (setq is-o-REx t))
                   (if (null i)
                       ;; Considered as 1arg form
                       (progn
@@ -3648,9 +4363,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                     (cperl-commentify b i t)
                     (if (looking-at "\\sw*e") ; s///e
                         (progn
+                          ;; Cache the syntax info...
+                          (setq cperl-syntax-state (cons state-point state))
                           (and
                            ;; silent:
-                           (cperl-find-pods-heres b1 (1- (point)) t end)
+                           (car (cperl-find-pods-heres b1 (1- (point)) t end))
                            ;; Error
                            (goto-char (1+ max)))
                           (if (and tag (eq (preceding-char) ?\>))
@@ -3658,6 +4375,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                 (cperl-modify-syntax-type (1- (point)) cperl-st-ket)
                                 (cperl-modify-syntax-type i cperl-st-bra)))
                           (put-text-property b i 'syntax-type 'string)
+                          (put-text-property i (point) 'syntax-type 'multiline)
                           (if is-x-REx
                               (put-text-property b i 'indentable t)))
                       (cperl-commentify b1 (point) t)
@@ -3673,7 +4391,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                         (forward-word 1) ; skip modifiers s///s
                         (if tail (cperl-commentify tail (point) t))
                         (cperl-postpone-fontification
-                         e1 (point) 'face 'cperl-nonoverridable)))
+                         e1 (point) 'face my-cperl-REx-modifiers-face)))
                   ;; Check whether it is m// which means "previous match"
                   ;; and highlight differently
                   (setq is-REx
@@ -3691,7 +4409,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                    (not (looking-at "split\\>")))
                                (error t))))
                       (cperl-postpone-fontification
-                       b e 'face font-lock-function-name-face)
+                       b e 'face font-lock-warning-face)
                     (if (or i2          ; Has 2 args
                             (and cperl-fontify-m-as-s
                                  (or
@@ -3700,135 +4418,417 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                        (not (eq ?\< (char-after b)))))))
                         (progn
                           (cperl-postpone-fontification
-                           b (cperl-1+ b) 'face font-lock-constant-face)
+                           b (cperl-1+ b) 'face my-cperl-delimiters-face)
                           (cperl-postpone-fontification
-                           (1- e) e 'face font-lock-constant-face)))
+                           (1- e) e 'face my-cperl-delimiters-face)))
                     (if (and is-REx cperl-regexp-scan)
-                        ;; Process RExen better
+                        ;; Process RExen: embedded comments, charclasses and ]
+;;;/\3333\xFg\x{FFF}a\ppp\PPP\qqq\C\99f(?{  foo  })(??{  foo  })/;
+;;;/a\.b[^a[:ff:]b]x$ab->$[|$,$ab->[cd]->[ef]|$ab[xy].|^${a,b}{c,d}/;
+;;;/(?<=foo)(?<!bar)(x)(?:$ab|\$\/)$|\\\b\x888\776\[\:$/xxx;
+;;;m?(\?\?{b,a})? + m/(??{aa})(?(?=xx)aa|bb)(?#aac)/;
+;;;m$(^ab[c]\$)$ + m+(^ab[c]\$\+)+ + m](^ab[c\]$|.+)] + m)(^ab[c]$|.+\));
+;;;m^a[\^b]c^ + m.a[^b]\.c.;
                         (save-excursion
                           (goto-char (1+ b))
+                          ;; First 
+                          (cperl-look-at-leading-count is-x-REx e)
+                          (setq hairy-RE
+                                (concat
+                                 (if is-x-REx
+                                     (if (eq (char-after b) ?\#)
+                                         "\\((\\?\\\\#\\)\\|\\(\\\\#\\)"
+                                       "\\((\\?#\\)\\|\\(#\\)")
+                                   ;; keep the same count: add a fake group
+                                   (if (eq (char-after b) ?\#)
+                                       "\\((\\?\\\\#\\)\\(\\)"
+                                     "\\((\\?#\\)\\(\\)"))
+                                 "\\|"
+                                    "\\(\\[\\)" ; 3=[
+                                 "\\|"
+                                    "\\(]\\)" ; 4=]
+                                 "\\|"
+                                 ;; XXXX Will not be able to use it in s)))
+                                 (if (eq (char-after b) ?\) )
+                                     "\\())))\\)" ; Will never match
+                                   (if (eq (char-after b) ?? )
+                                       ;;"\\((\\\\\\?\\(\\\\\\?\\)?{\\)"
+                                       "\\((\\\\\\?\\\\\\?{\\|()\\\\\\?{\\)"
+                                     "\\((\\?\\??{\\)")) ; 5= (??{ (?{
+                                 "\\|"  ; 6= 0-length, 7: name, 8,9:code, 10:group
+                                    "\\(" ;; XXXX 1-char variables, exc. |()\s
+                                       "[$@]"
+                                       "\\("
+                                          "[_a-zA-Z:][_a-zA-Z0-9:]*"
+                                       "\\|"
+                                          "{[^{}]*}" ; only one-level allowed
+                                       "\\|"
+                                          "[^{(|) \t\r\n\f]"
+                                       "\\)"
+                                       "\\(" ;;8,9:code part of array/hash elt
+                                          "\\(" "->" "\\)?"
+                                          "\\[[^][]*\\]"
+                                          "\\|"
+                                          "{[^{}]*}"
+                                       "\\)*"
+                                    ;; XXXX: what if u is delim?
+                                    "\\|"
+                                       "[)^|$.*?+]"
+                                    "\\|"
+                                       "{[0-9]+}"
+                                    "\\|"
+                                       "{[0-9]+,[0-9]*}"
+                                    "\\|"
+                                       "\\\\[luLUEQbBAzZG]"
+                                    "\\|"
+                                       "(" ; Group opener
+                                       "\\(" ; 10 group opener follower
+                                          "\\?\\((\\?\\)" ; 11: in (?(?=C)A|B)
+                                       "\\|"
+                                          "\\?[:=!>?{]" ; "?" something
+                                       "\\|"
+                                          "\\?[-imsx]+[:)]" ; (?i) (?-s:.)
+                                       "\\|"
+                                          "\\?([0-9]+)" ; (?(1)foo|bar)
+                                       "\\|"
+                                          "\\?<[=!]"
+                                       ;;;"\\|"
+                                       ;;;   "\\?"
+                                       "\\)?"
+                                    "\\)"
+                                 "\\|"
+                                    "\\\\\\(.\\)" ; 12=\SYMBOL
+                                 ))
                           (while
-                              (and (< (point) e)
-                                   (re-search-forward
-                                    (if is-x-REx
-                                        (if (eq (char-after b) ?\#)
-                                            "\\((\\?\\\\#\\)\\|\\(\\\\#\\)"
-                                          "\\((\\?#\\)\\|\\(#\\)")
-                                      (if (eq (char-after b) ?\#)
-                                          "\\((\\?\\\\#\\)"
-                                        "\\((\\?#\\)"))
-                                    (1- e) 'to-end))
+                              (and (< (point) (1- e))
+                                   (re-search-forward hairy-RE (1- e) 'to-end))
                             (goto-char (match-beginning 0))
-                            (setq REx-comment-start (point)
-                                  was-comment t)
-                            (if (save-excursion
-                                  (and
-                                   ;; XXX not working if outside delimiter is #
-                                   (eq (preceding-char) ?\\)
-                                   (= (% (skip-chars-backward "$\\\\") 2) -1)))
-                                ;; Not a comment, avoid loop:
-                                (progn (setq was-comment nil)
-                                       (forward-char 1))
-                              (if (match-beginning 2)
+                            (setq REx-subgr-start (point)
+                                  was-subgr (following-char))
+                            (cond
+                             ((match-beginning 6) ; 0-length builtins, groups
+                              (goto-char (match-end 0))
+                              (if (match-beginning 11)
+                                  (goto-char (match-beginning 11)))
+                              (if (>= (point) e)
+                                  (goto-char (1- e)))
+                              (cperl-postpone-fontification
+                               (match-beginning 0) (point)
+                               'face
+                               (cond
+                                ((eq was-subgr ?\) )
+                                 (condition-case nil
+                                     (save-excursion
+                                       (forward-sexp -1)
+                                       (if (> (point) b)
+                                           (if (if (eq (char-after b) ?? )
+                                                   (looking-at "(\\\\\\?")
+                                                 (eq (char-after (1+ (point))) ?\?))
+                                               my-cperl-REx-0length-face
+                                             my-cperl-REx-ctl-face)
+                                         font-lock-warning-face))
+                                   (error font-lock-warning-face)))
+                                ((eq was-subgr ?\| )
+                                 my-cperl-REx-ctl-face)
+                                ((eq was-subgr ?\$ )
+                                 (if (> (point) (1+ REx-subgr-start))
+                                     (progn
+                                       (put-text-property
+                                        (match-beginning 0) (point)
+                                        'REx-interpolated
+                                        (if is-o-REx 0
+                                            (if (and (eq (match-beginning 0)
+                                                         (1+ b))
+                                                     (eq (point)
+                                                         (1- e))) 1 t)))
+                                       font-lock-variable-name-face)
+                                   my-cperl-REx-spec-char-face))
+                                ((memq was-subgr (append "^." nil) )
+                                 my-cperl-REx-spec-char-face)
+                                ((eq was-subgr ?\( )
+                                 (if (not (match-beginning 10))
+                                     my-cperl-REx-ctl-face
+                                   my-cperl-REx-0length-face))
+                                (t my-cperl-REx-0length-face)))
+                              (if (and (memq was-subgr (append "(|" nil))
+                                       (not (string-match "(\\?[-imsx]+)"
+                                                          (match-string 0))))
+                                  (cperl-look-at-leading-count is-x-REx e))
+                              (setq was-subgr nil)) ; We do stuff here
+                             ((match-beginning 12) ; \SYMBOL
+                              (forward-char 2)
+                              (if (>= (point) e)
+                                  (goto-char (1- e))
+                                ;; How many chars to not highlight:
+                                ;; 0-len special-alnums in other branch =>
+                                ;; Generic:  \non-alnum (1), \alnum (1+face)
+                                ;; Is-delim: \non-alnum (1/spec-2) alnum-1 (=what hai)
+                                (setq REx-subgr-start (point)
+                                      qtag (preceding-char))
+                                (cperl-postpone-fontification
+                                 (- (point) 2) (- (point) 1) 'face
+                                 (if (memq qtag
+                                           (append "ghijkmoqvFHIJKMORTVY" nil))
+                                     font-lock-warning-face
+                                   my-cperl-REx-0length-face))
+                                (if (and (eq (char-after b) qtag)
+                                         (memq qtag (append ".])^$|*?+" nil)))
+                                    (progn
+                                      (if (and cperl-use-syntax-table-text-property
+                                               (eq qtag ?\) ))
+                                          (put-text-property
+                                           REx-subgr-start (1- (point))
+                                           'syntax-table cperl-st-punct))
+                                      (cperl-postpone-fontification
+                                       (1- (point)) (point) 'face
+                                        ; \] can't appear below
+                                       (if (memq qtag (append ".]^$" nil))
+                                           'my-cperl-REx-spec-char-face
+                                         (if (memq qtag (append "*?+" nil))
+                                             'my-cperl-REx-0length-face
+                                           'my-cperl-REx-ctl-face))))) ; )|
+                                ;; Test for arguments:
+                                (cond
+                                 ;; This is not pretty: the 5.8.7 logic:
+                                 ;; \0numx  -> octal (up to total 3 dig)
+                                 ;; \DIGIT  -> backref unless \0
+                                 ;; \DIGITs -> backref if legal
+                                 ;;          otherwise up to 3 -> octal
+                                 ;; Do not try to distinguish, we guess
+                                 ((or (and (memq qtag (append "01234567" nil))
+                                           (re-search-forward
+                                            "\\=[01234567]?[01234567]?"
+                                            (1- e) 'to-end))
+                                      (and (memq qtag (append "89" nil))
+                                           (re-search-forward 
+                                            "\\=[0123456789]*" (1- e) 'to-end))
+                                      (and (eq qtag ?x)
+                                           (re-search-forward
+                                            "\\=[0-9a-fA-F][0-9a-fA-F]?\\|\\={[0-9a-fA-F]+}"
+                                            (1- e) 'to-end))
+                                      (and (memq qtag (append "pPN" nil))
+                                           (re-search-forward "\\={[^{}]+}\\|."
+                                            (1- e) 'to-end))
+                                      (eq (char-syntax qtag) ?w))
+                                  (cperl-postpone-fontification
+                                   (1- REx-subgr-start) (point)
+                                   'face my-cperl-REx-length1-face))))
+                              (setq was-subgr nil)) ; We do stuff here
+                             ((match-beginning 3) ; [charclass]
+                              (forward-char 1)
+                              (if (eq (char-after b) ?^ )
+                                  (and (eq (following-char) ?\\ )
+                                       (eq (char-after (cperl-1+ (point)))
+                                           ?^ )
+                                       (forward-char 2))
+                                (and (eq (following-char) ?^ )
+                                     (forward-char 1)))
+                              (setq argument b ; continue?
+                                    tag nil ; list of POSIX classes
+                                    qtag (point))
+                              (if (eq (char-after b) ?\] )
+                                  (and (eq (following-char) ?\\ )
+                                       (eq (char-after (cperl-1+ (point)))
+                                           ?\] )
+                                       (setq qtag (1+ qtag))
+                                       (forward-char 2))
+                                (and (eq (following-char) ?\] )
+                                     (forward-char 1)))
+                              ;; Apparently, I can't put \] into a charclass
+                              ;; in m]]: m][\\\]\]] produces [\\]]
+;;; POSIX?  [:word:] [:^word:] only inside []
+;;;                                    "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]")
+                              (while 
+                                  (and argument
+                                       (re-search-forward
+                                        (if (eq (char-after b) ?\] )
+                                            "\\=\\(\\\\[^]]\\|[^]\\\\]\\)*\\\\]"
+                                          "\\=\\(\\\\.\\|[^]\\\\]\\)*]")
+                                        (1- e) 'toend))
+                                ;; Is this ] an end of POSIX class?
+                                (if (save-excursion
+                                      (and
+                                       (search-backward "[" argument t)
+                                       (< REx-subgr-start (point))
+                                       (not
+                                        (and ; Should work with delim = \
+                                         (eq (preceding-char) ?\\ )
+                                         (= (% (skip-chars-backward
+                                                "\\\\") 2) 0)))
+                                       (looking-at
+                                        (cond
+                                         ((eq (char-after b) ?\] )
+                                          "\\\\*\\[:\\^?\\sw+:\\\\\\]")
+                                         ((eq (char-after b) ?\: )
+                                          "\\\\*\\[\\\\:\\^?\\sw+\\\\:]")
+                                         ((eq (char-after b) ?^ )
+                                          "\\\\*\\[:\\(\\\\\\^\\)?\\sw+:\]")
+                                         ((eq (char-syntax (char-after b))
+                                              ?w)
+                                          (concat
+                                           "\\\\*\\[:\\(\\\\\\^\\)?\\(\\\\"
+                                           (char-to-string (char-after b))
+                                           "\\|\\sw\\)+:\]"))
+                                         (t "\\\\*\\[:\\^?\\sw*:]")))
+                                       (setq argument (point))))
+                                    (setq tag (cons (cons argument (point))
+                                                    tag)
+                                          argument (point)) ; continue
+                                  (setq argument nil)))
+                              (and argument
+                                   (message "Couldn't find end of charclass in a REx, pos=%s"
+                                            REx-subgr-start))
+                              (if (and cperl-use-syntax-table-text-property
+                                       (> (- (point) 2) REx-subgr-start))
+                                  (put-text-property
+                                   (1+ REx-subgr-start) (1- (point))
+                                   'syntax-table cperl-st-punct))
+                              (cperl-postpone-fontification
+                               REx-subgr-start qtag
+                               'face my-cperl-REx-spec-char-face)
+                              (cperl-postpone-fontification
+                               (1- (point)) (point) 'face
+                               my-cperl-REx-spec-char-face)
+                              (if (eq (char-after b) ?\] )
+                                  (cperl-postpone-fontification
+                                   (- (point) 2) (1- (point))
+                                   'face my-cperl-REx-0length-face))
+                              (while tag
+                                (cperl-postpone-fontification
+                                 (car (car tag)) (cdr (car tag))
+                                 'face my-cperl-REx-length1-face)
+                                (setq tag (cdr tag)))
+                              (setq was-subgr nil)) ; did facing already
+                             ;; Now rare stuff:
+                             ((and (match-beginning 2) ; #-comment
+                                   (/= (match-beginning 2) (match-end 2)))
+                              (beginning-of-line 2)
+                              (if (> (point) e)
+                                  (goto-char (1- e))))
+                             ((match-beginning 4) ; character "]"
+                              (setq was-subgr nil) ; We do stuff here
+                              (goto-char (match-end 0))
+                              (if cperl-use-syntax-table-text-property
+                                  (put-text-property
+                                   (1- (point)) (point)
+                                   'syntax-table cperl-st-punct))
+                              (cperl-postpone-fontification
+                               (1- (point)) (point)
+                               'face font-lock-warning-face))
+                             ((match-beginning 5) ; before (?{}) (??{})
+                              (setq tag (match-end 0))
+                              (if (or (setq qtag
+                                            (cperl-forward-group-in-re st-l))
+                                      (and (>= (point) e)
+                                           (setq qtag "no matching `)' found"))
+                                      (and (not (eq (char-after (- (point) 2))
+                                                    ?\} ))
+                                           (setq qtag "Can't find })")))
                                   (progn
-                                    (beginning-of-line 2)
-                                    (if (> (point) e)
-                                        (goto-char (1- e))))
-                                ;; Works also if the outside delimiters are ().
-                                (or (search-forward ")" (1- e) 'toend)
-                                    (message
-                                     "Couldn't find end of (?#...)-comment in a REx, pos=%s"
-                                     REx-comment-start))))
+                                    (goto-char (1- e))
+                                    (message qtag))
+                                (cperl-postpone-fontification
+                                 (1- tag) (1- (point))
+                                 'face font-lock-variable-name-face)
+                                (cperl-postpone-fontification
+                                 REx-subgr-start (1- tag)
+                                 'face my-cperl-REx-spec-char-face)
+                                (cperl-postpone-fontification
+                                 (1- (point)) (point)
+                                 'face my-cperl-REx-spec-char-face)
+                                (if cperl-use-syntax-table-text-property
+                                    (progn
+                                      (put-text-property
+                                       (- (point) 2) (1- (point))
+                                       'syntax-table cperl-st-cfence)
+                                      (put-text-property
+                                       (+ REx-subgr-start 2)
+                                       (+ REx-subgr-start 3)
+                                       'syntax-table cperl-st-cfence))))
+                              (setq was-subgr nil))
+                             (t         ; (?#)-comment
+                              ;; Inside "(" and "\" arn't special in any way
+                              ;; Works also if the outside delimiters are ().
+                              (or;;(if (eq (char-after b) ?\) )
+                               ;;(re-search-forward
+                               ;; "[^\\\\]\\(\\\\\\\\\\)*\\\\)"
+                               ;; (1- e) 'toend)
+                               (search-forward ")" (1- e) 'toend)
+                               ;;)
+                               (message
+                                "Couldn't find end of (?#...)-comment in a REx, pos=%s"
+                                REx-subgr-start))))
                             (if (>= (point) e)
                                 (goto-char (1- e)))
-                            (if was-comment
-                                (progn
-                                  (setq REx-comment-end (point))
-                                  (cperl-commentify
-                                   REx-comment-start REx-comment-end nil)
-                                  (cperl-postpone-fontification
-                                   REx-comment-start REx-comment-end
-                                   'face font-lock-comment-face))))))
+                            (cond
+                             (was-subgr
+                              (setq REx-subgr-end (point))
+                              (cperl-commentify
+                               REx-subgr-start REx-subgr-end nil)
+                              (cperl-postpone-fontification
+                               REx-subgr-start REx-subgr-end
+                               'face font-lock-comment-face))))))
                     (if (and is-REx is-x-REx)
                         (put-text-property (1+ b) (1- e)
                                            'syntax-subtype 'x-REx)))
                   (if i2
                       (progn
                         (cperl-postpone-fontification
-                         (1- e1) e1 'face font-lock-constant-face)
+                         (1- e1) e1 'face my-cperl-delimiters-face)
                         (if (assoc (char-after b) cperl-starters)
-                            (cperl-postpone-fontification
-                             b1 (1+ b1) 'face font-lock-constant-face))))
+                            (progn
+                              (cperl-postpone-fontification
+                               b1 (1+ b1) 'face my-cperl-delimiters-face)
+                              (put-text-property b1 (1+ b1)
+                                           'REx-part2 t)))))
                   (if (> (point) max)
                       (setq tmpend tb))))
-               ((match-beginning 13)    ; sub with prototypes
-                (setq b (match-beginning 0))
+               ((match-beginning 17)    ; sub with prototype or attribute
+                ;; 1+6+2+1+1=11 extra () before this (sub with proto/attr):
+                ;;"\\<sub\\>\\("                        ;12
+                ;;   cperl-white-and-comment-rex        ;13
+                ;;   "\\([a-zA-Z_:'0-9]+\\)\\)?" ; name ;14
+                ;;"\\(" cperl-maybe-white-and-comment-rex       ;15,16
+                ;;   "\\(([^()]*)\\|:[^:]\\)\\)" ; 17:proto or attribute start
+                (setq b1 (match-beginning 14) e1 (match-end 14))
                 (if (memq (char-after (1- b))
                           '(?\$ ?\@ ?\% ?\& ?\*))
                     nil
-                  (setq state (parse-partial-sexp
-                               state-point b nil nil state)
-                        state-point b)
-                  (if (or (nth 3 state) (nth 4 state))
-                      nil
-                    ;; Mark as string
-                    (cperl-commentify (match-beginning 13) (match-end 13) t))
-                  (goto-char (match-end 0))))
-               ;; 1+6+2+1+1+2=13 extra () before this:
-               ;;    "\\$\\(['{]\\)"
-               ((and (match-beginning 14)
-                     (eq (preceding-char) ?\')) ; $'
-                (setq b (1- (point))
-                      state (parse-partial-sexp
-                             state-point (1- b) nil nil state)
-                      state-point (1- b))
-                (if (nth 3 state)       ; in string
-                    (cperl-modify-syntax-type (1- b) cperl-st-punct))
-                (goto-char (1+ b)))
-               ;; 1+6+2+1+1+2=13 extra () before this:
-               ;;    "\\$\\(['{]\\)"
-               ((match-beginning 14)    ; ${
-                (setq bb (match-beginning 0))
-                (cperl-modify-syntax-type bb cperl-st-punct))
-               ;; 1+6+2+1+1+2+1=14 extra () before this:
+                  (goto-char b)
+                  (if (eq (char-after (match-beginning 17)) ?\( )
+                      (progn
+                        (cperl-commentify ; Prototypes; mark as string
+                         (match-beginning 17) (match-end 17) t)
+                        (goto-char (match-end 0))
+                        ;; Now look for attributes after prototype:
+                        (forward-comment (buffer-size))
+                        (and (looking-at ":[^:]")
+                             (cperl-find-sub-attrs st-l b1 e1 b)))
+                    ;; treat attributes without prototype
+                    (goto-char (match-beginning 17))
+                    (cperl-find-sub-attrs st-l b1 e1 b))))
+               ;; 1+6+2+1+1+6+1=18 extra () before this:
                ;;    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
-               ((match-beginning 15)    ; old $abc'efg syntax
-                (setq bb (match-end 0)
-                      b (match-beginning 0)
-                      state (parse-partial-sexp
-                             state-point b nil nil state)
-                      state-point b)
-                (if (nth 3 state)       ; in string
-                    nil
-                  (put-text-property (1- bb) bb 'syntax-table cperl-st-word))
+               ((match-beginning 19)    ; old $abc'efg syntax
+                (setq bb (match-end 0))
+                ;;;(if (nth 3 state) nil        ; in string
+                (put-text-property (1- bb) bb 'syntax-table cperl-st-word)
                 (goto-char bb))
-               ;; 1+6+2+1+1+2+1+1=15 extra () before this:
+               ;; 1+6+2+1+1+6+1+1=19 extra () before this:
                ;; "__\\(END\\|DATA\\)__"
-               ((match-beginning 16)    ; __END__, __DATA__
-                (setq bb (match-end 0)
-                      b (match-beginning 0)
-                      state (parse-partial-sexp
-                             state-point b nil nil state)
-                      state-point b)
-                (if (or (nth 3 state) (nth 4 state))
-                    nil
-                  ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
-                  (cperl-commentify b bb nil)
-                  (setq end t))
-                (goto-char bb))
-               ((match-beginning 17)    ; "\\\\\\(['`\"($]\\)"
-                ;; Trailing backslash ==> non-quoting outside string/comment
-                (setq bb (match-end 0)
-                      b (match-beginning 0))
+               ((match-beginning 20)    ; __END__, __DATA__
+                (setq bb (match-end 0))
+                ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
+                (cperl-commentify b bb nil)
+                (setq end t))
+               ;; "\\\\\\(['`\"($]\\)"
+               ((match-beginning 21)
+                ;; Trailing backslash; make non-quoting outside string/comment
+                (setq bb (match-end 0))
                 (goto-char b)
                 (skip-chars-backward "\\\\")
                 ;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1))
-                (setq state (parse-partial-sexp
-                             state-point b nil nil state)
-                      state-point b)
-                (if (or (nth 3 state) (nth 4 state) )
-                    nil
-                  (cperl-modify-syntax-type b cperl-st-punct))
+                (cperl-modify-syntax-type b cperl-st-punct)
                 (goto-char bb))
                (t (error "Error in regexp of the sniffer")))
               (if (> (point) stop-point)
@@ -3839,7 +4839,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                       (or (car err-l) (setcar err-l b)))
                     (goto-char stop-point))))
             (setq cperl-syntax-state (cons state-point state)
-                  cperl-syntax-done-to (or tmpend (max (point) max))))
+                  ;; Do not mark syntax as done past tmpend???
+                  cperl-syntax-done-to (or tmpend (max (point) max)))
+            ;;(message "state-at=%s, done-to=%s" state-point cperl-syntax-done-to)
+            )
           (if (car err-l) (goto-char (car err-l))
             (or non-inter
                 (message "Scanning for \"hard\" Perl constructions... done"))))
@@ -3851,48 +4854,91 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
       ;; cperl-mode-syntax-table.
       ;; (set-syntax-table cperl-mode-syntax-table)
       )
-    (car err-l)))
+    (list (car err-l) overshoot)))
+
+(defun cperl-find-pods-heres-region (min max)
+  (interactive "r")
+  (cperl-find-pods-heres min max))
 
 (defun cperl-backward-to-noncomment (lim)
   ;; Stops at lim or after non-whitespace that is not in comment
+  ;; XXXX Wrongly understands end-of-multiline strings with # as comment
   (let (stop p pr)
-    (while (and (not stop) (> (point) (or lim 1)))
+    (while (and (not stop) (> (point) (or lim (point-min))))
       (skip-chars-backward " \t\n\f" lim)
       (setq p (point))
       (beginning-of-line)
       (if (memq (setq pr (get-text-property (point) 'syntax-type))
                 '(pod here-doc here-doc-delim))
           (cperl-unwind-to-safe nil)
-      (or (looking-at "^[ \t]*\\(#\\|$\\)")
-          (progn (cperl-to-comment-or-eol) (bolp))
-          (progn
-            (skip-chars-backward " \t")
-            (if (< p (point)) (goto-char p))
-            (setq stop t)))))))
+        (or (and (looking-at "^[ \t]*\\(#\\|$\\)")
+                 (not (memq pr '(string prestring))))
+            (progn (cperl-to-comment-or-eol) (bolp))
+            (progn
+              (skip-chars-backward " \t")
+              (if (< p (point)) (goto-char p))
+              (setq stop t)))))))
 
+;; Used only in `cperl-calculate-indent'...
+(defun cperl-block-p ()            ; Do not C-M-q !  One string contains ";" !
+  ;; Positions is before ?\{.  Checks whether it starts a block.
+  ;; No save-excursion!  This is more a distinguisher of a block/hash ref...
+  (cperl-backward-to-noncomment (point-min))
+  (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label!  \C-@ at bobp
+                                        ; Label may be mixed up with `$blah :'
+      (save-excursion (cperl-after-label))
+      (get-text-property (cperl-1- (point)) 'attrib-group)
+      (and (memq (char-syntax (preceding-char)) '(?w ?_))
+           (progn
+             (backward-sexp)
+             ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr'
+             (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax
+                      (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>")))
+                 ;; sub bless::foo {}
+                 (progn
+                   (cperl-backward-to-noncomment (point-min))
+                   (and (eq (preceding-char) ?b)
+                        (progn
+                          (forward-sexp -1)
+                          (looking-at "sub[ \t\n\f#]")))))))))
+
+;;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)?
+;;; No save-excursion; condition-case ...  In (cperl-block-p) the block
+;;; may be a part of an in-statement construct, such as
+;;;   ${something()}, print {FH} $data.
+;;; Moreover, one takes positive approach (looks for else,grep etc)
+;;; another negative (looks for bless,tr etc)
 (defun cperl-after-block-p (lim &optional pre-block)
-  "Return true if the preceeding } ends a block or a following { starts one.
-Would not look before LIM.  If PRE-BLOCK is nil checks preceeding }.
-otherwise following {."
-  ;; We suppose that the preceding char is }.
+  "Return true if the preceeding } (if PRE-BLOCK, following {) delimits a block.
+Would not look before LIM.  Assumes that LIM is a good place to begin a
+statement.  The kind of block we treat here is one after which a new
+statement would start; thus the block in ${func()} does not count."
   (save-excursion
     (condition-case nil
         (progn
           (or pre-block (forward-sexp -1))
           (cperl-backward-to-noncomment lim)
           (or (eq (point) lim)
-              (eq (preceding-char) ?\) ) ; if () {}    sub f () {}
-              (if (eq (char-syntax (preceding-char)) ?w) ; else {}
+              ;; if () {}   // sub f () {}   // sub f :a(') {}
+              (eq (preceding-char) ?\) )
+              ;; label: {}
+              (save-excursion (cperl-after-label))
+              ;; sub :attr {}
+              (get-text-property (cperl-1- (point)) 'attrib-group)
+              (if (memq (char-syntax (preceding-char)) '(?w ?_)) ; else {}
                   (save-excursion
                     (forward-sexp -1)
-                    (or (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
+                    ;; else {}     but not    else::func {}
+                    (or (and (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
+                             (not (looking-at "\\(\\sw\\|_\\)+::")))
                         ;; sub f {}
                         (progn
                           (cperl-backward-to-noncomment lim)
-                          (and (eq (char-syntax (preceding-char)) ?w)
+                          (and (eq (preceding-char) ?b)
                                (progn
                                  (forward-sexp -1)
-                                 (looking-at "sub\\>"))))))
+                                 (looking-at "sub[ \t\n\f#]"))))))
+                ;; What preceeds is not word...  XXXX Last statement in sub???
                 (cperl-after-expr-p lim))))
       (error nil))))
 
@@ -3914,14 +4960,12 @@ CHARS is a string that contains good characters to have before us (however,
         (if (get-text-property (point) 'here-doc-group)
             (progn
               (goto-char
-               (or (previous-single-property-change (point) 'here-doc-group)
-                   (point)))
+               (cperl-beginning-of-property (point) 'here-doc-group))
               (beginning-of-line 0)))
         (if (get-text-property (point) 'in-pod)
             (progn
               (goto-char
-               (or (previous-single-property-change (point) 'in-pod)
-                   (point)))
+               (cperl-beginning-of-property (point) 'in-pod))
               (beginning-of-line 0)))
         (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
           ;; Else: last iteration, or a label
@@ -3933,7 +4977,7 @@ CHARS is a string that contains good characters to have before us (however,
                    (progn
                      (forward-char -1)
                      (skip-chars-backward " \t\n\f" lim)
-                     (eq (char-syntax (preceding-char)) ?w)))
+                     (memq (char-syntax (preceding-char)) '(?w ?_))))
               (forward-sexp -1)         ; Possibly label.  Skip it
             (goto-char p)
             (setq stop t))))
@@ -3949,6 +4993,44 @@ CHARS is a string that contains good characters to have before us (however,
                        (eq (get-text-property (point) 'syntax-type)
                            'format)))))))))
 
+(defun cperl-backward-to-start-of-expr (&optional lim)
+  (condition-case nil
+      (progn
+        (while (and (or (not lim)
+                        (> (point) lim))
+                    (not (cperl-after-expr-p lim)))
+          (forward-sexp -1)
+          ;; May be after $, @, $# etc of a variable
+          (skip-chars-backward "$@%#")))
+    (error nil)))
+
+(defun cperl-at-end-of-expr (&optional lim)
+  ;; Since the SEXP approach below is very fragile, do some overengineering
+  (or (looking-at (concat cperl-maybe-white-and-comment-rex "[;}]"))
+      (condition-case nil
+          (save-excursion
+            ;; If nothing interesting after, does as (forward-sexp -1);
+            ;; otherwise fails, or ends at a start of following sexp.
+            ;; XXXX PROBLEMS: if what follows (after ";") @FOO, or ${bar}
+            ;; may be stuck after @ or $; just put some stupid workaround now:
+            (let ((p (point)))
+              (forward-sexp 1)
+              (forward-sexp -1)
+              (while (memq (preceding-char) (append "%&@$*" nil))
+                (forward-char -1))
+              (or (< (point) p)
+                  (cperl-after-expr-p lim))))
+        (error t))))
+
+(defun cperl-forward-to-end-of-expr (&optional lim)
+  (let ((p (point))))
+  (condition-case nil
+      (progn
+        (while (and (< (point) (or lim (point-max)))
+                    (not (cperl-at-end-of-expr)))
+          (forward-sexp 1)))
+    (error nil)))
+
 (defun cperl-backward-to-start-of-continued-exp (lim)
   (if (memq (preceding-char) (append ")]}\"'`" nil))
       (forward-sexp -1))
@@ -3989,18 +5071,51 @@ conditional/loop constructs."
         (beginning-of-line)
         (while (null done)
           (setq top (point))
-          (while (= (nth 0 (parse-partial-sexp (point) tmp-end
-                                               -1)) -1)
+          ;; Plan A: if line has an unfinished paren-group, go to end-of-group
+          (while (= -1 (nth 0 (parse-partial-sexp (point) tmp-end -1)))
             (setq top (point)))         ; Get the outermost parenths in line
           (goto-char top)
           (while (< (point) tmp-end)
             (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
             (or (eolp) (forward-sexp 1)))
-          (if (> (point) tmp-end)
-              (save-excursion
-                (end-of-line)
-                (setq tmp-end (point)))
-            (setq done t)))
+          (if (> (point) tmp-end)       ; Yes, there an unfinished block
+              nil
+            (if (eq ?\) (preceding-char))
+                (progn ;; Plan B: find by REGEXP block followup this line
+                  (setq top (point))
+                  (condition-case nil
+                      (progn
+                        (forward-sexp -2)
+                        (if (eq (following-char) ?$ ) ; for my $var (list)
+                            (progn
+                              (forward-sexp -1)
+                              (if (looking-at "\\(my\\|local\\|our\\)\\>")
+                                  (forward-sexp -1))))
+                        (if (looking-at
+                             (concat "\\(\\elsif\\|if\\|unless\\|while\\|until"
+                                     "\\|for\\(each\\)?\\>\\(\\("
+                                     cperl-maybe-white-and-comment-rex
+                                     "\\(my\\|local\\|our\\)\\)?"
+                                     cperl-maybe-white-and-comment-rex
+                                     "\\$[_a-zA-Z0-9]+\\)?\\)\\>"))
+                            (progn
+                              (goto-char top)
+                              (forward-sexp 1)
+                              (setq top (point)))))
+                    (error (setq done t)))
+                  (goto-char top))
+              (if (looking-at           ; Try Plan C: continuation block
+                   (concat cperl-maybe-white-and-comment-rex
+                           "\\<\\(else\\|elsif\|continue\\)\\>"))
+                  (progn
+                    (goto-char (match-end 0))
+                    (save-excursion
+                      (end-of-line)
+                      (setq tmp-end (point))))
+                (setq done t))))
+          (save-excursion
+            (end-of-line)
+            (setq tmp-end (point))))
         (goto-char tmp-end)
         (setq tmp-end (point-marker)))
       (if cperl-indent-region-fix-constructs
@@ -4029,16 +5144,26 @@ Returns some position at the last line."
         ;; Looking at:
         ;; }
         ;; else
-        (if (and cperl-merge-trailing-else
-                 (looking-at
-                  "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>"))
-            (progn
-              (search-forward "}")
-              (setq p (point))
-              (skip-chars-forward " \t\n")
-              (delete-region p (point))
+        (if cperl-merge-trailing-else
+            (if (looking-at
+                 "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
+                (progn
+                  (search-forward "}")
+                  (setq p (point))
+                  (skip-chars-forward " \t\n")
+                  (delete-region p (point))
               (insert (make-string cperl-indent-region-fix-constructs ?\s))
-              (beginning-of-line)))
+                  (beginning-of-line)))
+          (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
+              (save-excursion
+                  (search-forward "}")
+                  (delete-horizontal-space)
+                  (insert "\n")
+                  (setq ret (point))
+                  (if (cperl-indent-line parse-data)
+                      (progn
+                        (cperl-fix-line-spacing end parse-data)
+                        (setq ret (point)))))))
         ;; Looking at:
         ;; }     else
         (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")
@@ -4075,19 +5200,19 @@ Returns some position at the last line."
               (insert
                (make-string cperl-indent-region-fix-constructs ?\s))
               (beginning-of-line)))
-        ;; Looking at:
-        ;; } foreach my $var ()    {
+        ;; Looking at (with or without "}" at start, ending after "({"):
+        ;; } foreach my $var ()         OR   {
         (if (looking-at
              "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")
             (progn
-              (setq ml (match-beginning 8))
+              (setq ml (match-beginning 8)) ; "(" or "{" after control word
               (re-search-forward "[({]")
               (forward-char -1)
               (setq p (point))
               (if (eq (following-char) ?\( )
                   (progn
                     (forward-sexp 1)
-                    (setq pp (point)))
+                    (setq pp (point)))  ; past parenth-group
                 ;; after `else' or nothing
                 (if ml                  ; after `else'
                     (skip-chars-backward " \t\n")
@@ -4097,13 +5222,13 @@ Returns some position at the last line."
               ;; Multiline expr should be special
               (setq ml (and pp (save-excursion (goto-char p)
                                                (search-forward "\n" pp t))))
-              (if (and (or (not pp) (< pp end))
+              (if (and (or (not pp) (< pp end)) ; Do not go too far...
                        (looking-at "[ \t\n]*{"))
                   (progn
                     (cond
                      ((bolp)            ; Were before `{', no if/else/etc
                       nil)
-                     ((looking-at "\\(\t*\\| [ \t]+\\){")
+                     ((looking-at "\\(\t*\\| [ \t]+\\){") ; Not exactly 1 SPACE
                       (delete-horizontal-space)
                       (if (if ml
                               cperl-extra-newline-before-brace-multiline
@@ -4126,7 +5251,17 @@ Returns some position at the last line."
                       (skip-chars-forward " \t\n")
                       (delete-region pp (point))
                       (insert
-                       (make-string cperl-indent-region-fix-constructs ?\s))))
+                       (make-string cperl-indent-region-fix-constructs ?\ )))
+                     ((and (looking-at "[\t ]*{")
+                           (if ml cperl-extra-newline-before-brace-multiline
+                             cperl-extra-newline-before-brace))
+                      (delete-horizontal-space)
+                      (insert "\n")
+                      (setq ret (point))
+                      (if (cperl-indent-line parse-data)
+                          (progn
+                            (cperl-fix-line-spacing end parse-data)
+                            (setq ret (point))))))
                     ;; Now we are before `{'
                     (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]")
                         (progn
@@ -4278,7 +5413,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
   ;; (interactive "P") ; Only works when called from fill-paragraph.  -stef
   (let (;; Non-nil if the current line contains a comment.
         has-comment
-
+        fill-paragraph-function         ; do not recurse
         ;; If has-comment, the appropriate fill-prefix for the comment.
         comment-fill-prefix
         ;; Line that contains code and comment (or nil)
@@ -4310,7 +5445,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
               dc (- c (current-column)) len (- start (point))
               start (point-marker))
         (delete-char len)
-        (insert (make-string dc ?-)))))
+        (insert (make-string dc ?-))))) ; Placeholder (to avoid splitting???)
     (if (not has-comment)
         (fill-paragraph justify)       ; Do the usual thing outside of comment
       ;; Narrow to include only the comment, and then fill the region.
@@ -4332,11 +5467,16 @@ indentation and initial hashes.  Behaves usually outside of comment."
            (point)))
         ;; Remove existing hashes
         (save-excursion
-          (goto-char (point-min))
-          (while (progn (forward-line 1) (< (point) (point-max)))
-            (skip-chars-forward " \t")
-            (and (looking-at "#+")
-                 (delete-char (- (match-end 0) (match-beginning 0))))))
+        (goto-char (point-min))
+        (while (progn (forward-line 1) (< (point) (point-max)))
+          (skip-chars-forward " \t")
+          (if (looking-at "#+")
+              (progn
+                (if (and (eq (point) (match-beginning 0))
+                         (not (eq (point) (match-end 0)))) nil
+                    (error
+ "Bug in Emacs: `looking-at' in `narrow-to-region': match-data is garbage"))
+                (delete-char (- (match-end 0) (match-beginning 0)))))))
 
         ;; Lines with only hashes on them can be paragraph boundaries.
         (let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$"))
@@ -4352,7 +5492,8 @@ indentation and initial hashes.  Behaves usually outside of comment."
               (setq comment-column c)
               (indent-for-comment)
               ;; Repeat once more, flagging as iteration
-              (cperl-fill-paragraph justify t)))))))
+              (cperl-fill-paragraph justify t))))))
+  t)
 
 (defun cperl-do-auto-fill ()
   ;; Break out if the line is short enough
@@ -4403,8 +5544,8 @@ indentation and initial hashes.  Behaves usually outside of comment."
   (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
         (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
         (index-meth-alist '()) meth
-        packages ends-ranges p marker
-        (prev-pos 0) char fchar index index1 name (end-range 0) package)
+        packages ends-ranges p marker is-proto
+        (prev-pos 0) is-pack index index1 name (end-range 0) package)
     (goto-char (point-min))
     (cperl-update-syntaxification (point-max) (point-max))
     ;; Search for the function
@@ -4412,72 +5553,81 @@ indentation and initial hashes.  Behaves usually outside of comment."
       (while (re-search-forward
               (or regexp cperl-imenu--function-name-regexp-perl)
               nil t)
+        ;; 2=package-group, 5=package-name 8=sub-name
         (cond
          ((and                          ; Skip some noise if building tags
-           (match-beginning 2)          ; package or sub
-           (eq (char-after (match-beginning 2)) ?p) ; package
+           (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'
           nil)
          ((and
-           (match-beginning 2)          ; package or sub
+           (or (match-beginning 2)
+               (match-beginning 8))             ; 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))
            (null (get-text-property (match-beginning 1) 'in-pod)))
-          (save-excursion
-            (goto-char (match-beginning 2))
-            (setq fchar (following-char)))
+          (setq is-pack (match-beginning 2))
           ;; (if (looking-at "([^()]*)[ \t\n\f]*")
           ;;    (goto-char (match-end 0)))      ; Messes what follows
-          (setq char (following-char)   ; ?\; for "sub foo () ;"
-                meth nil
+          (setq meth nil
                 p (point))
           (while (and ends-ranges (>= p (car ends-ranges)))
             ;; delete obsolete entries
             (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
           (setq package (or (car packages) "")
                 end-range (or (car ends-ranges) 0))
-          (if (eq fchar ?p)
-              (setq name (buffer-substring (match-beginning 3) (match-end 3))
-                    name (progn
-                           (set-text-properties 0 (length name) nil name)
-                           name)
-                    package (concat name "::")
-                    name (concat "package " name)
-                    end-range
-                    (save-excursion
-                      (parse-partial-sexp (point) (point-max) -1) (point))
-                    ends-ranges (cons end-range ends-ranges)
-                    packages (cons package packages)))
-          ;;   )
+          (if is-pack                   ; doing "package"
+              (progn
+                (if (match-beginning 5) ; named package
+                    (setq name (buffer-substring (match-beginning 5)
+                                                 (match-end 5))
+                          name (progn
+                                 (set-text-properties 0 (length name) nil name)
+                                 name)
+                          package (concat name "::")
+                          name (concat "package " name))
+                  ;; Support nameless packages
+                  (setq name "package;" package ""))
+                (setq end-range
+                      (save-excursion
+                        (parse-partial-sexp (point) (point-max) -1) (point))
+                      ends-ranges (cons end-range ends-ranges)
+                      packages (cons package packages)))
+            (setq is-proto
+                  (or (eq (following-char) ?\;)
+                      (eq 0 (get-text-property (point) 'attrib-group)))))
           ;; Skip this function name if it is a prototype declaration.
-          (if (and (eq fchar ?s) (eq char ?\;)) nil
-            (setq name (buffer-substring (match-beginning 3) (match-end 3))
-                  marker (make-marker))
-            (set-text-properties 0 (length name) nil name)
-            (set-marker marker (match-end 3))
-            (if (eq fchar ?p)
-                (setq name (concat "package " name))
-              (cond ((string-match "[:']" name)
-                     (setq meth t))
-                    ((> p end-range) nil)
-                    (t
-                     (setq name (concat package name) meth t))))
+          (if (and is-proto (not is-pack)) nil
+            (or is-pack
+                (setq name
+                      (buffer-substring (match-beginning 8) (match-end 8)))
+                (set-text-properties 0 (length name) nil name))
+            (setq marker (make-marker))
+            (set-marker marker (match-end (if is-pack 2 8)))
+            (cond (is-pack nil)
+                  ((string-match "[:']" name)
+                   (setq meth t))
+                  ((> p end-range) nil)
+                  (t
+                   (setq name (concat package name) meth t)))
             (setq index (cons name marker))
-            (if (eq fchar ?p)
+            (if is-pack
                 (push index index-pack-alist)
               (push index index-alist))
             (if meth (push index index-meth-alist))
             (push index index-unsorted-alist)))
-         ((match-beginning 5)           ; POD section
-          ;; (beginning-of-line)
-          (setq index (imenu-example--name-and-position)
-                name (buffer-substring (match-beginning 6) (match-end 6)))
+         ((match-beginning 16)          ; POD section
+          (setq name (buffer-substring (match-beginning 17) (match-end 17))
+                marker (make-marker))
+          (set-marker marker (match-beginning 17))
           (set-text-properties 0 (length name) nil name)
-          (if (eq (char-after (match-beginning 5)) ?2)
-              (setq name (concat "   " name)))
-          (setcar index name)
+          (setq name (concat (make-string
+                              (* 3 (- (char-after (match-beginning 16)) ?1))
+                              ?\ )
+                             name)
+                index (cons name marker))
           (setq index1 (cons (concat "=" name) (cdr index)))
           (push index index-pod-alist)
           (push index1 index-unsorted-alist)))))
@@ -4541,29 +5691,20 @@ indentation and initial hashes.  Behaves usually outside of comment."
 (defun cperl-outline-level ()
   (looking-at outline-regexp)
   (cond ((not (match-beginning 1)) 0)   ; beginning-of-file
-        ((match-beginning 2)
-         (if (eq (char-after (match-beginning 2)) ?p)
-             0                          ; package
-           1))                          ; sub
-        ((match-beginning 5)
-         (if (eq (char-after (match-beginning 5)) ?1)
-             1                          ; head1
-           2))                          ; head2
-        (t 3)))                         ; should not happen
+;;;; 2=package-group, 5=package-name 8=sub-name 16=head-level
+        ((match-beginning 2) 0)         ; package
+        ((match-beginning 8) 1)         ; sub
+        ((match-beginning 16)
+         (- (char-after (match-beginning 16)) ?0)) ; headN ==> N
+        (t 5)))                         ; should not happen
 
 
 (defvar cperl-compilation-error-regexp-alist
-  ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK).
+  ;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS).
   '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
      2 3))
   "Alist that specifies how to match errors in perl output.")
 
-(if (fboundp 'eval-after-load)
-    (eval-after-load
-        "mode-compile"
-      '(setq perl-compilation-error-regexp-alist
-             cperl-compilation-error-regexp-alist)))
-
 
 (defun cperl-windowed-init ()
   "Initialization under windowed version."
@@ -4604,9 +5745,12 @@ indentation and initial hashes.  Behaves usually outside of comment."
   ;; Allow `cperl-find-pods-heres' to run.
   (or (boundp 'font-lock-constant-face)
       (cperl-force-face font-lock-constant-face
-                        "Face for constant and label names")
-      ;;(setq font-lock-constant-face 'font-lock-constant-face)
-      ))
+                        "Face for constant and label names"))
+  (or (boundp 'font-lock-warning-face)
+      (cperl-force-face font-lock-warning-face
+                        "Face for things which should stand out"))
+  ;;(setq font-lock-constant-face 'font-lock-constant-face)
+  )
 
 (defun cperl-init-faces ()
   (condition-case errs
@@ -4629,7 +5773,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
                'identity
                '("if" "until" "while" "elsif" "else" "unless" "for"
                  "foreach" "continue" "exit" "die" "last" "goto" "next"
-                 "redo" "return" "local" "exec" "sub" "do" "dump" "use"
+                 "redo" "return" "local" "exec" "sub" "do" "dump" "use" "our"
                  "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT")
                "\\|")                   ; Flow control
               "\\)\\>") 2)              ; was "\\)[ \n\t;():,\|&]"
@@ -4713,7 +5857,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
               ;; "chop" "defined" "delete" "do" "each" "else" "elsif"
               ;; "eval" "exists" "for" "foreach" "format" "goto"
               ;; "grep" "if" "keys" "last" "local" "map" "my" "next"
-              ;; "no" "package" "pop" "pos" "print" "printf" "push"
+              ;; "no" "our" "package" "pop" "pos" "print" "printf" "push"
               ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift"
               ;; "sort" "splice" "split" "study" "sub" "tie" "tr"
               ;; "undef" "unless" "unshift" "untie" "until" "use"
@@ -4728,15 +5872,38 @@ indentation and initial hashes.  Behaves usually outside of comment."
               "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
               "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
               "\\|[sm]"                 ; Added manually
-              "\\)\\>") 2 'cperl-nonoverridable)
+              "\\)\\>") 2 'cperl-nonoverridable-face)
             ;;          (mapconcat 'identity
             ;;                     '("#endif" "#else" "#ifdef" "#ifndef" "#if"
             ;;                       "#include" "#define" "#undef")
             ;;                     "\\|")
             '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
               font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
-            '("\\<sub[ \t]+\\([^ \t{;()]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1
-              font-lock-function-name-face)
+            ;; This highlights declarations and definitions differenty.
+            ;; We do not try to highlight in the case of attributes:
+            ;; it is already done by `cperl-find-pods-heres'
+            (list (concat "\\<sub"
+                          cperl-white-and-comment-rex ; whitespace/comments
+                          "\\([^ \n\t{;()]+\\)" ; 2=name (assume non-anonymous)
+                          "\\("
+                            cperl-maybe-white-and-comment-rex ;whitespace/comments?
+                            "([^()]*)\\)?" ; prototype
+                          cperl-maybe-white-and-comment-rex ; whitespace/comments?
+                          "[{;]")
+                  2 (if cperl-font-lock-multiline
+                        '(if (eq (char-after (cperl-1- (match-end 0))) ?\{ )
+                             'font-lock-function-name-face
+                           'font-lock-variable-name-face)
+                      ;; need to manually set 'multiline' for older font-locks
+                      '(progn
+                         (if (< 1 (count-lines (match-beginning 0)
+                                               (match-end 0)))
+                             (put-text-property
+                              (+ 3 (match-beginning 0)) (match-end 0)
+                              'syntax-type 'multiline))
+                         (if (eq (char-after (cperl-1- (match-end 0))) ?\{ )
+                             'font-lock-function-name-face
+                           'font-lock-variable-name-face))))
             '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
               2 font-lock-function-name-face)
             '("^[ \t]*format[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t]*=[ \t]*$"
@@ -4772,12 +5939,56 @@ indentation and initial hashes.  Behaves usually outside of comment."
                                    (2 '(restart 2 nil) nil t)))
                         nil t)))        ; local variables, multiple
                   (font-lock-anchored
-                   '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
-                     (3 font-lock-variable-name-face)
-                     ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)"
-                      nil nil
-                      (1 font-lock-variable-name-face))))
-                  (t '("^[ \t{}]*\\(my\\|local\\our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
+                   ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var
+                   (` ((, (concat "\\<\\(my\\|local\\|our\\)"
+                                  cperl-maybe-white-and-comment-rex
+                                  "\\(("
+                                     cperl-maybe-white-and-comment-rex
+                                  "\\)?\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)"))
+                       (5 (, (if cperl-font-lock-multiline
+                                 'font-lock-variable-name-face
+                               '(progn  (setq cperl-font-lock-multiline-start
+                                              (match-beginning 0))
+                                        'font-lock-variable-name-face))))
+                       ((, (concat "\\="
+                                   cperl-maybe-white-and-comment-rex
+                                   ","
+                                   cperl-maybe-white-and-comment-rex
+                                   "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)"))
+                        ;; Bug in font-lock: limit is used not only to limit 
+                        ;; searches, but to set the "extend window for
+                        ;; facification" property.  Thus we need to minimize.
+                        (, (if cperl-font-lock-multiline
+                             '(if (match-beginning 3)
+                                  (save-excursion
+                                    (goto-char (match-beginning 3))
+                                    (condition-case nil
+                                        (forward-sexp 1)
+                                      (error
+                                       (condition-case nil
+                                           (forward-char 200)
+                                         (error nil)))) ; typeahead
+                                    (1- (point))) ; report limit
+                                (forward-char -2)) ; disable continued expr
+                             '(if (match-beginning 3)
+                                  (point-max) ; No limit for continuation
+                                (forward-char -2)))) ; disable continued expr
+                        (, (if cperl-font-lock-multiline
+                               nil
+                             '(progn    ; Do at end
+                                ;; "my" may be already fontified (POD),
+                                ;; so cperl-font-lock-multiline-start is nil
+                                (if (or (not cperl-font-lock-multiline-start)
+                                        (> 2 (count-lines
+                                              cperl-font-lock-multiline-start
+                                              (point))))
+                                    nil
+                                  (put-text-property
+                                   (1+ cperl-font-lock-multiline-start) (point)
+                                   'syntax-type 'multiline))
+                                (setq cperl-font-lock-multiline-start nil))))
+                        (3 font-lock-variable-name-face)))))
+                  (t '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
                        3 font-lock-variable-name-face)))
             '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
               4 font-lock-variable-name-face)
@@ -4787,21 +5998,32 @@ indentation and initial hashes.  Behaves usually outside of comment."
           (setq
            t-font-lock-keywords-1
            (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
-                (not cperl-xemacs-p)    ; not yet as of XEmacs 19.12
+                ;; not yet as of XEmacs 19.12, works with 21.1.11
+                (or
+                 (not cperl-xemacs-p)
+                 (string< "21.1.9" emacs-version)
+                 (and (string< "21.1.10" emacs-version)
+                      (string< emacs-version "21.1.2")))
                 '(
                   ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
                    (if (eq (char-after (match-beginning 2)) ?%)
-                       'cperl-hash
-                     'cperl-array)
+                       'cperl-hash-face
+                     'cperl-array-face)
                    t)                   ; arrays and hashes
                   ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
                    1
                    (if (= (- (match-end 2) (match-beginning 2)) 1)
                        (if (eq (char-after (match-beginning 3)) ?{)
-                           'cperl-hash
-                         'cperl-array) ; arrays and hashes
+                           'cperl-hash-face
+                         'cperl-array-face) ; arrays and hashes
                      font-lock-variable-name-face) ; Just to put something
                    t)
+                  ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)"
+                   (1 cperl-array-face)
+                   (2 font-lock-variable-name-face))
+                  ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)"
+                   (1 cperl-hash-face)
+                   (2 font-lock-variable-name-face))
                   ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
                        ;;; Too much noise from \s* @s[ and friends
                   ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)"
@@ -4813,7 +6035,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
           (if cperl-highlight-variables-indiscriminately
               (setq t-font-lock-keywords-1
                     (append t-font-lock-keywords-1
-                            (list '("[$*]{?\\(\\sw+\\)" 1
+                            (list '("\\([$*]{?\\sw+\\)" 1
                                     font-lock-variable-name-face)))))
           (setq cperl-font-lock-keywords-1
                 (if cperl-syntaxify-by-font-lock
@@ -4866,27 +6088,35 @@ indentation and initial hashes.  Behaves usually outside of comment."
                       [nil              nil             t               t       t]
                       nil
                       [nil              nil             t               t       t])
+                (list 'font-lock-warning-face
+                      ["Pink"           "Red"           "Gray50"        "LightGray"]
+                      ["gray20"         "gray90"
+                                                        "gray80"        "gray20"]
+                      [nil              nil             t               t       t]
+                      nil
+                      [nil              nil             t               t       t]
+                      )
                 (list 'font-lock-constant-face
                       ["CadetBlue"      "Aquamarine"    "Gray50"        "LightGray"]
                       nil
                       [nil              nil             t               t       t]
                       nil
                       [nil              nil             t               t       t])
-                (list 'cperl-nonoverridable
+                (list 'cperl-nonoverridable-face
                       ["chartreuse3"    ("orchid1" "orange")
                        nil              "Gray80"]
                       [nil              nil             "gray90"]
                       [nil              nil             nil             t       t]
                       [nil              nil             t               t]
                       [nil              nil             t               t       t])
-                (list 'cperl-array
+                (list 'cperl-array-face
                       ["blue"           "yellow"        nil             "Gray80"]
                       ["lightyellow2"   ("navy" "os2blue" "darkgreen")
                        "gray90"]
                       t
                       nil
                       nil)
-                (list 'cperl-hash
+                (list 'cperl-hash-face
                       ["red"            "red"           nil             "Gray80"]
                       ["lightyellow2"   ("navy" "os2blue" "darkgreen")
                        "gray90"]
@@ -4909,15 +6139,17 @@ indentation and initial hashes.  Behaves usually outside of comment."
                             "Face for variable names")
           (cperl-force-face font-lock-type-face
                             "Face for data types")
-          (cperl-force-face cperl-nonoverridable
+          (cperl-force-face cperl-nonoverridable-face
                             "Face for data types from another group")
+          (cperl-force-face font-lock-warning-face
+                            "Face for things which should stand out")
           (cperl-force-face font-lock-comment-face
                             "Face for comments")
           (cperl-force-face font-lock-function-name-face
                             "Face for function names")
-          (cperl-force-face cperl-hash
+          (cperl-force-face cperl-hash-face
                             "Face for hashes")
-          (cperl-force-face cperl-array
+          (cperl-force-face cperl-array-face
                             "Face for arrays")
           ;;(defvar font-lock-constant-face 'font-lock-constant-face)
           ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
@@ -4927,7 +6159,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
           ;;    "Face to use for data types."))
           ;;(or (boundp 'cperl-nonoverridable-face)
           ;;    (defconst cperl-nonoverridable-face
-          ;;    'cperl-nonoverridable
+          ;;    'cperl-nonoverridable-face
           ;;    "Face to use for data types from another group."))
           ;;(if (not cperl-xemacs-p) nil
           ;;  (or (boundp 'font-lock-comment-face)
@@ -4943,24 +6175,24 @@ indentation and initial hashes.  Behaves usually outside of comment."
           ;;      'font-lock-function-name-face
           ;;      "Face to use for function names.")))
           (if (and
-               (not (cperl-is-face 'cperl-array))
+               (not (cperl-is-face 'cperl-array-face))
                (cperl-is-face 'font-lock-emphasized-face))
-              (copy-face 'font-lock-emphasized-face 'cperl-array))
+              (copy-face 'font-lock-emphasized-face 'cperl-array-face))
           (if (and
-               (not (cperl-is-face 'cperl-hash))
+               (not (cperl-is-face 'cperl-hash-face))
                (cperl-is-face 'font-lock-other-emphasized-face))
-              (copy-face 'font-lock-other-emphasized-face 'cperl-hash))
+              (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face))
           (if (and
-               (not (cperl-is-face 'cperl-nonoverridable))
+               (not (cperl-is-face 'cperl-nonoverridable-face))
                (cperl-is-face 'font-lock-other-type-face))
-              (copy-face 'font-lock-other-type-face 'cperl-nonoverridable))
+              (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face))
           ;;(or (boundp 'cperl-hash-face)
           ;;    (defconst cperl-hash-face
-          ;;    'cperl-hash
+          ;;    'cperl-hash-face
           ;;    "Face to use for hashes."))
           ;;(or (boundp 'cperl-array-face)
           ;;    (defconst cperl-array-face
-          ;;    'cperl-array
+          ;;    'cperl-array-face
           ;;    "Face to use for arrays."))
           ;; Here we try to guess background
           (let ((background
@@ -4999,17 +6231,17 @@ indentation and initial hashes.  Behaves usually outside of comment."
                                        "pink")))
                (t
                 (set-face-background 'font-lock-type-face "gray90"))))
-            (if (cperl-is-face 'cperl-nonoverridable)
+            (if (cperl-is-face 'cperl-nonoverridable-face)
                 nil
-              (copy-face 'font-lock-type-face 'cperl-nonoverridable)
+              (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
               (cond
                ((eq background 'light)
-                (set-face-foreground 'cperl-nonoverridable
+                (set-face-foreground 'cperl-nonoverridable-face
                                      (if (x-color-defined-p "chartreuse3")
                                          "chartreuse3"
                                        "chartreuse")))
                ((eq background 'dark)
-                (set-face-foreground 'cperl-nonoverridable
+                (set-face-foreground 'cperl-nonoverridable-face
                                      (if (x-color-defined-p "orchid1")
                                          "orchid1"
                                        "orange")))))
@@ -5061,15 +6293,15 @@ indentation and initial hashes.  Behaves usually outside of comment."
     '(setq ps-bold-faces
            ;;                   font-lock-variable-name-face
            ;;                   font-lock-constant-face
-           (append '(cperl-array cperl-hash)
+           (append '(cperl-array-face cperl-hash-face)
                    ps-bold-faces)
            ps-italic-faces
            ;;                   font-lock-constant-face
-           (append '(cperl-nonoverridable cperl-hash)
+           (append '(cperl-nonoverridable-face cperl-hash-face)
                    ps-italic-faces)
            ps-underlined-faces
            ;;        font-lock-type-face
-           (append '(cperl-array cperl-hash underline cperl-nonoverridable)
+           (append '(cperl-array-face cperl-hash-face underline cperl-nonoverridable-face)
                    ps-underlined-faces))))
 
 (defvar ps-print-face-extension-alist)
@@ -5102,27 +6334,27 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'."
 ;;;   (defvar ps-italic-faces nil)
 ;;;   (setq ps-bold-faces
 ;;;     (append '(font-lock-emphasized-face
-;;;               cperl-array
+;;;               cperl-array-face
 ;;;               font-lock-keyword-face
 ;;;               font-lock-variable-name-face
 ;;;               font-lock-constant-face
 ;;;               font-lock-reference-face
 ;;;               font-lock-other-emphasized-face
-;;;               cperl-hash)
+;;;               cperl-hash-face)
 ;;;             ps-bold-faces))
 ;;;   (setq ps-italic-faces
-;;;     (append '(cperl-nonoverridable
+;;;     (append '(cperl-nonoverridable-face
 ;;;               font-lock-constant-face
 ;;;               font-lock-reference-face
 ;;;               font-lock-other-emphasized-face
-;;;               cperl-hash)
+;;;               cperl-hash-face)
 ;;;             ps-italic-faces))
 ;;;   (setq ps-underlined-faces
 ;;;     (append '(font-lock-emphasized-face
-;;;               cperl-array
+;;;               cperl-array-face
 ;;;               font-lock-other-emphasized-face
-;;;               cperl-hash
-;;;               cperl-nonoverridable font-lock-type-face)
+;;;               cperl-hash-face
+;;;               cperl-nonoverridable-face font-lock-type-face)
 ;;;             ps-underlined-faces))
 ;;;   (cons 'font-lock-type-face ps-underlined-faces))
 
@@ -5132,79 +6364,211 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'."
 (defconst cperl-styles-entries
   '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset
     cperl-label-offset cperl-extra-newline-before-brace
+    cperl-extra-newline-before-brace-multiline
     cperl-merge-trailing-else
     cperl-continued-statement-offset))
 
+(defconst cperl-style-examples
+"##### Numbers etc are: cperl-indent-level cperl-brace-offset
+##### cperl-continued-brace-offset cperl-label-offset
+##### cperl-continued-statement-offset
+##### cperl-merge-trailing-else cperl-extra-newline-before-brace
+
+########### (Do not forget cperl-extra-newline-before-brace-multiline)
+
+### CPerl       (=GNU - extra-newline-before-brace + merge-trailing-else) 2/0/0/-2/2/t/nil
+if (foo) {
+  bar
+    baz;
+ label:
+  {
+    boon;
+  }
+} else {
+  stop;
+}
+
+### PerlStyle   (=CPerl with 4 as indent)               4/0/0/-4/4/t/nil
+if (foo) {
+    bar
+        baz;
+ label:
+    {
+        boon;
+    }
+} else {
+    stop;
+}
+
+### GNU                                                 2/0/0/-2/2/nil/t
+if (foo)
+  {
+    bar
+      baz;
+  label:
+    {
+      boon;
+    }
+  }
+else
+  {
+    stop;
+  }
+
+### C++         (=PerlStyle with braces aligned with control words) 4/0/-4/-4/4/nil/t
+if (foo)
+{
+    bar
+        baz;
+ label:
+    {
+        boon;
+    }
+}
+else
+{
+    stop;
+}
+
+### BSD         (=C++, but will not change preexisting merge-trailing-else
+###              and extra-newline-before-brace )               4/0/-4/-4/4
+if (foo)
+{
+    bar
+        baz;
+ label:
+    {
+        boon;
+    }
+}
+else
+{
+    stop;
+}
+
+### K&R         (=C++ with indent 5 - merge-trailing-else, but will not
+###              change preexisting extra-newline-before-brace) 5/0/-5/-5/5/nil
+if (foo)
+{
+     bar
+          baz;
+ label:
+     {
+          boon;
+     }
+}
+else
+{
+     stop;
+}
+
+### Whitesmith  (=PerlStyle, but will not change preexisting
+###              extra-newline-before-brace and merge-trailing-else) 4/0/0/-4/4
+if (foo)
+    {
+        bar
+            baz;
+    label:
+        {
+            boon;
+        }
+    }
+else
+    {
+        stop;
+    }
+"
+"Examples of if/else with different indent styles (with v4.23).")
+
 (defconst cperl-style-alist
-  '(("CPerl"                         ; =GNU without extra-newline-before-brace
+  '(("CPerl" ;; =GNU - extra-newline-before-brace + cperl-merge-trailing-else
      (cperl-indent-level               .  2)
      (cperl-brace-offset               .  0)
      (cperl-continued-brace-offset     .  0)
      (cperl-label-offset               . -2)
+     (cperl-continued-statement-offset .  2)
      (cperl-extra-newline-before-brace .  nil)
-     (cperl-merge-trailing-else        .  t)
-     (cperl-continued-statement-offset .  2))
+     (cperl-extra-newline-before-brace-multiline .  nil)
+     (cperl-merge-trailing-else        .  t))
+
     ("PerlStyle"                        ; CPerl with 4 as indent
      (cperl-indent-level               .  4)
      (cperl-brace-offset               .  0)
      (cperl-continued-brace-offset     .  0)
      (cperl-label-offset               . -4)
+     (cperl-continued-statement-offset .  4)
      (cperl-extra-newline-before-brace .  nil)
-     (cperl-merge-trailing-else        .  t)
-     (cperl-continued-statement-offset .  4))
+     (cperl-extra-newline-before-brace-multiline .  nil)
+     (cperl-merge-trailing-else        .  t))
+
     ("GNU"
      (cperl-indent-level               .  2)
      (cperl-brace-offset               .  0)
      (cperl-continued-brace-offset     .  0)
      (cperl-label-offset               . -2)
+     (cperl-continued-statement-offset .  2)
      (cperl-extra-newline-before-brace .  t)
-     (cperl-merge-trailing-else        .  nil)
-     (cperl-continued-statement-offset .  2))
+     (cperl-extra-newline-before-brace-multiline .  t)
+     (cperl-merge-trailing-else        .  nil))
+
     ("K&R"
      (cperl-indent-level               .  5)
      (cperl-brace-offset               .  0)
      (cperl-continued-brace-offset     . -5)
      (cperl-label-offset               . -5)
+     (cperl-continued-statement-offset .  5)
      ;;(cperl-extra-newline-before-brace .  nil) ; ???
-     (cperl-merge-trailing-else        .  nil)
-     (cperl-continued-statement-offset .  5))
+     ;;(cperl-extra-newline-before-brace-multiline .  nil)
+     (cperl-merge-trailing-else        .  nil))
+
     ("BSD"
      (cperl-indent-level               .  4)
      (cperl-brace-offset               .  0)
      (cperl-continued-brace-offset     . -4)
      (cperl-label-offset               . -4)
+     (cperl-continued-statement-offset .  4)
      ;;(cperl-extra-newline-before-brace .  nil) ; ???
-     (cperl-continued-statement-offset .  4))
+     ;;(cperl-extra-newline-before-brace-multiline .  nil)
+     ;;(cperl-merge-trailing-else              .  nil) ; ???
+     )
+
     ("C++"
      (cperl-indent-level               .  4)
      (cperl-brace-offset               .  0)
      (cperl-continued-brace-offset     . -4)
      (cperl-label-offset               . -4)
      (cperl-continued-statement-offset .  4)
-     (cperl-merge-trailing-else        .  nil)
-     (cperl-extra-newline-before-brace .  t))
-    ("Current")
+     (cperl-extra-newline-before-brace .  t)
+     (cperl-extra-newline-before-brace-multiline .  t)
+     (cperl-merge-trailing-else        .  nil))
+
     ("Whitesmith"
      (cperl-indent-level               .  4)
      (cperl-brace-offset               .  0)
      (cperl-continued-brace-offset     .  0)
      (cperl-label-offset               . -4)
+     (cperl-continued-statement-offset .  4)
      ;;(cperl-extra-newline-before-brace .  nil) ; ???
-     (cperl-continued-statement-offset .  4)))
-  "(Experimental) list of variables to set to get a particular indentation style.
-Should be used via `cperl-set-style' or via Perl menu.")
+     ;;(cperl-extra-newline-before-brace-multiline .  nil)
+     ;;(cperl-merge-trailing-else              .  nil) ; ???
+     )
+    ("Current"))
+  "List of variables to set to get a particular indentation style.
+Should be used via `cperl-set-style' or via Perl menu.
+
+See examples in `cperl-style-examples'.")
 
 (defun cperl-set-style (style)
   "Set CPerl mode variables to use one of several different indentation styles.
 The arguments are a string representing the desired style.
 The list of styles is in `cperl-style-alist', available styles
-are GNU, K&R, BSD, C++ and Whitesmith.
+are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith.
 
 The current value of style is memorized (unless there is a memorized
 data already), may be restored by `cperl-set-style-back'.
 
 Chosing \"Current\" style will not change style, so this may be used for
-side-effect of memorizing only."
+side-effect of memorizing only.  Examples in `cperl-style-examples'."
   (interactive
    (let ((list (mapcar (function (lambda (elt) (list (car elt))))
                        cperl-style-alist)))
@@ -5375,6 +6739,8 @@ Customized by setting variables `cperl-shrink-wrap-info-frame',
    (match-beginning 1) (match-end 1)))
 
 (defun cperl-imenu-on-info ()
+  "Shows imenu for Perl Info Buffer.
+Opens Perl Info buffer if needed."
   (interactive)
   (let* ((buffer (current-buffer))
          imenu-create-index-function
@@ -5414,7 +6780,7 @@ If STEP is nil, `cperl-lineup-step' will be used
 \(or `cperl-indent-level', if `cperl-lineup-step' is nil).
 Will not move the position at the start to the left."
   (interactive "r")
-  (let (search col tcol seen b e)
+  (let (search col tcol seen b)
     (save-excursion
       (goto-char end)
       (end-of-line)
@@ -5452,22 +6818,25 @@ Will not move the position at the start to the left."
       (if (/= (% col step) 0) (setq step (* step (1+ (/ col step)))))
       (while
           (progn
-            (setq e (point))
-            (skip-chars-backward " \t")
-            (delete-region (point) e)
-            (indent-to-column col) ;(make-string (- col (current-column)) ?\s))
+            (cperl-make-indent col)
             (beginning-of-line 2)
             (and (< (point) end)
                  (re-search-forward search end t)
                  (goto-char (match-beginning 0)))))))) ; No body
 
-(defun cperl-etags (&optional add all files)
+(defun cperl-etags (&optional add all files) ;; NOT USED???
   "Run etags with appropriate options for Perl files.
 If optional argument ALL is `recursive', will process Perl files
 in subdirectories too."
   (interactive)
   (let ((cmd "etags")
-        (args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([{#]\\|$\\)\\)/\\4/"))
+        (args '("-l" "none" "-r"
+                ;;       1=fullname  2=package?             3=name                       4=proto?             5=attrs? (VERY APPROX!)
+                "/\\<sub[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/"
+                "-r"
+                "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/"
+                "-r"
+                "/\\<\\(package\\)[ \\t]*;/\\1;/"))
         res)
     (if add (setq args (cons "-a" args)))
     (or files (setq files (list buffer-file-name)))
@@ -5539,6 +6908,29 @@ Delay of auto-help controlled by `cperl-lazy-help-time'."
   (message "indent-region/indent-sexp will %sbe automatically fix whitespace."
            (if cperl-indent-region-fix-constructs "" "not ")))
 
+(defun cperl-toggle-set-debug-unwind (arg &optional backtrace)
+  "Toggle (or, with numeric argument, set) debugging state of syntaxification.
+Nonpositive numeric argument disables debugging messages.  The message
+summarizes which regions it was decided to rescan for syntactic constructs.
+
+The message looks like this:
+
+  Syxify req=123..138 actual=101..146 done-to: 112=>146 statepos: 73=>117
+
+Numbers are character positions in the buffer.  REQ provides the range to
+rescan requested by `font-lock'.  ACTUAL is the range actually resyntaxified;
+for correct operation it should start and end outside any special syntactic
+construct.  DONE-TO and STATEPOS indicate changes to internal caches maintained
+by CPerl."
+  (interactive "P")
+  (or arg
+      (setq arg (if (eq cperl-syntaxify-by-font-lock 
+                        (if backtrace 'backtrace 'message)) 0 1)))
+  (setq arg (if (> arg 0) (if backtrace 'backtrace 'message) t))
+  (setq cperl-syntaxify-by-font-lock arg)
+  (message "Debugging messages of syntax unwind %sabled."
+           (if (eq arg t) "dis" "en")))
+
 ;;;; Tags file creation.
 
 (defvar cperl-tmp-buffer " *cperl-tmp*")
@@ -5679,13 +7071,22 @@ Delay of auto-help controlled by `cperl-lazy-help-time'."
         ret))))
 
 (defun cperl-add-tags-recurse-noxs ()
-  "Add to TAGS data for Perl and XSUB files in the current directory and kids.
+  "Add to TAGS data for \"pure\" Perl files in the current directory and kids.
 Use as
   emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
-        -f cperl-add-tags-recurse
+        -f cperl-add-tags-recurse-noxs
 "
   (cperl-write-tags nil nil t t nil t))
 
+(defun cperl-add-tags-recurse-noxs-fullpath ()
+  "Add to TAGS data for \"pure\" Perl in the current directory and kids.
+Writes down fullpath, so TAGS is relocatable (but if the build directory
+is relocated, the file TAGS inside it breaks). Use as
+  emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+        -f cperl-add-tags-recurse-noxs-fullpath
+"
+  (cperl-write-tags nil nil t t nil t ""))
+
 (defun cperl-add-tags-recurse ()
   "Add to TAGS file data for Perl files in the current directory and kids.
 Use as
@@ -5855,9 +7256,9 @@ One may build such TAGS files from CPerl mode menu."
               (cperl-tags-hier-fill))
           (or tags-table-list
               (call-interactively 'visit-tags-table))
-        (mapcar
-         (function
-          (lambda (tagsfile)
+          (mapcar
+           (function
+            (lambda (tagsfile)
               (message "Updating list of classes... %s" tagsfile)
             (set-buffer (get-file-buffer tagsfile))
             (cperl-tags-hier-fill)))
@@ -6019,7 +7420,7 @@ One may build such TAGS files from CPerl mode menu."
    '("[^-\t <>=+]\\(--\\|\\+\\+\\)"     ; var-- var++
      "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]"    ; abc|def abc&def are often used.
      "&[(a-zA-Z0-9_$]"                  ; &subroutine &(var->field)
-     "<\\$?\\sw+\\(\\.\\sw+\\)?>"       ; <IN> <stdin.h>
+     "<\\$?\\sw+\\(\\.\\(\\sw\\|_\\)+\\)?>"     ; <IN> <stdin.h>
      "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]"    ; -f file, -t STDIN
      "-[0-9]"                           ; -5
      "\\+\\+"                           ; ++var
@@ -6051,8 +7452,7 @@ Currently it is tuned to C and Perl syntax."
   (interactive)
   (let (found-bad (p (point)))
     (setq last-nonmenu-event 13)        ; To disable popup
-    (with-no-warnings  ; It is useful to push the mark here.
-     (beginning-of-buffer))
+    (goto-char (point-min))
     (map-y-or-n-p "Insert space here? "
                   (lambda (arg) (insert " "))
                   'cperl-next-bad-style
@@ -6448,7 +7848,7 @@ endservent
 eof[([FILEHANDLE])]
 ... eq ...      String equality.
 eval(EXPR) or eval { BLOCK }
-exec(LIST)
+exec([TRUENAME] ARGV0, ARGVs)     or     exec(SHELL_COMMAND_LINE)
 exit(EXPR)
 exp(EXPR)
 fcntl(FILEHANDLE,FUNCTION,SCALAR)
@@ -6584,7 +7984,7 @@ substr(EXPR,OFFSET[,LEN])
 symlink(OLDFILE,NEWFILE)
 syscall(LIST)
 sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
-system(LIST)
+system([TRUENAME] ARGV0 [,ARGV])     or     system(SHELL_COMMAND_LINE)
 syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
 tell[(FILEHANDLE)]
 telldir(DIRHANDLE)
@@ -6685,7 +8085,7 @@ prototype \\&SUB	Returns prototype of the function given a reference.
   ;; b is before the starting delimiter, e before the ending
   ;; e should be a marker, may be changed, but remains "correct".
   ;; EMBED is nil iff we process the whole REx.
-  ;; The REx is guarantied to have //x
+  ;; The REx is guaranteed to have //x
   ;; LEVEL shows how many levels deep to go
   ;; position at enter and at leave is not defined
   (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos)
@@ -6714,7 +8114,7 @@ prototype \\&SUB	Returns prototype of the function given a reference.
           (goto-char e)
           (delete-horizontal-space)
           (insert "\n")
-          (indent-to-column c)
+          (cperl-make-indent c)
           (set-marker e (point))))
     (goto-char b)
     (end-of-line 2)
@@ -6724,7 +8124,7 @@ prototype \\&SUB	Returns prototype of the function given a reference.
             inline t)
       (skip-chars-forward " \t")
       (delete-region s (point))
-      (indent-to-column c1)
+      (cperl-make-indent c1)
       (while (and
               inline
               (looking-at
@@ -6750,6 +8150,16 @@ prototype \\&SUB	Returns prototype of the function given a reference.
                         (eq (preceding-char) ?\{)))
                (forward-char -1)
                (forward-sexp 1))
+              ((and                     ; [], already syntaxified
+                (match-beginning 6)
+                cperl-regexp-scan
+                cperl-use-syntax-table-text-property)
+               (forward-char -1)
+               (forward-sexp 1)
+               (or (eq (preceding-char) ?\])
+                   (error "[]-group not terminated"))
+               (re-search-forward
+                "\\=\\([*+?]\\|{[0-9]+\\(,[0-9]*\\)?}\\)\\??" e t))
               ((match-beginning 6)      ; []
                (setq tmp (point))
                (if (looking-at "\\^?\\]")
@@ -6763,12 +8173,8 @@ prototype \\&SUB	Returns prototype of the function given a reference.
                    (setq pos t)))
                (or (eq (preceding-char) ?\])
                    (error "[]-group not terminated"))
-               (if (eq (following-char) ?\{)
-                   (progn
-                     (forward-sexp 1)
-                     (and (eq (following-char) ??)
-                          (forward-char 1)))
-                 (re-search-forward "\\=\\([*+?]\\??\\)" e t)))
+               (re-search-forward
+                "\\=\\([*+?]\\|{[0-9]+\\(,[0-9]*\\)?}\\)\\??" e t))
               ((match-beginning 7)      ; ()
                (goto-char (match-beginning 0))
                (setq pos (current-column))
@@ -6776,7 +8182,7 @@ prototype \\&SUB	Returns prototype of the function given a reference.
                    (progn
                      (delete-horizontal-space)
                      (insert "\n")
-                     (indent-to-column c1)))
+                     (cperl-make-indent c1)))
                (setq tmp (point))
                (forward-sexp 1)
                ;;              (or (forward-sexp 1)
@@ -6836,7 +8242,7 @@ prototype \\&SUB	Returns prototype of the function given a reference.
                      (insert "\n"))
                  ;; first at line
                  (delete-region (point) tmp))
-               (indent-to-column c)
+               (cperl-make-indent c)
                (forward-char 1)
                (skip-chars-forward " \t")
                (setq spaces nil)
@@ -6859,10 +8265,7 @@ prototype \\&SUB	Returns prototype of the function given a reference.
              (/= (current-indentation) c))
         (progn
           (beginning-of-line)
-          (setq s (point))
-          (skip-chars-forward " \t")
-          (delete-region s (point))
-          (indent-to-column c)))))
+          (cperl-make-indent c)))))
 
 (defun cperl-make-regexp-x ()
   ;; Returns position of the start
@@ -6931,7 +8334,7 @@ We suppose that the regexp is scanned already."
   (interactive)
   ;; (save-excursion            ; Can't, breaks `cperl-contract-levels'
   (cperl-regext-to-level-start)
-  (let ((b (point)) (e (make-marker)) s c)
+  (let ((b (point)) (e (make-marker)) c)
     (forward-sexp 1)
     (set-marker e (1- (point)))
     (goto-char b)
@@ -6940,10 +8343,7 @@ We suppose that the regexp is scanned already."
        ((match-beginning 1)             ; #-comment
         (or c (setq c (current-indentation)))
         (beginning-of-line 2)           ; Skip
-        (setq s (point))
-        (skip-chars-forward " \t")
-        (delete-region s (point))
-        (indent-to-column c))
+        (cperl-make-indent c))
        (t
         (delete-char -1)
         (just-one-space))))))
@@ -6982,96 +8382,197 @@ We suppose that the regexp is scanned already."
       (set-marker e (1- (point)))
       (cperl-beautify-regexp-piece b e nil deep))))
 
+(defun cperl-invert-if-unless-modifiers ()
+  "Change `B if A;' into `if (A) {B}' etc if possible.
+\(Unfinished.)"
+  (interactive)                         ; 
+  (let (A B pre-B post-B pre-if post-if pre-A post-A if-string
+          (w-rex "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>"))
+    (and (= (char-syntax (preceding-char)) ?w)
+         (forward-sexp -1))
+    (setq pre-if (point))
+    (cperl-backward-to-start-of-expr)
+    (setq pre-B (point))
+    (forward-sexp 1)            ; otherwise forward-to-end-of-expr is NOP
+    (cperl-forward-to-end-of-expr)
+    (setq post-A (point))
+    (goto-char pre-if)
+    (or (looking-at w-rex)
+        ;; Find the position
+        (progn (goto-char post-A)
+               (while (and
+                       (not (looking-at w-rex))
+                       (> (point) pre-B))
+                 (forward-sexp -1))
+               (setq pre-if (point))))
+    (or (looking-at w-rex)
+        (error "Can't find `if', `unless', `while', `until', `for' or `foreach'"))
+    ;; 1 B 2 ... 3 B-com ... 4 if 5 ... if-com 6 ... 7 A 8
+    (setq if-string (buffer-substring (match-beginning 0) (match-end 0)))
+    ;; First, simple part: find code boundaries
+    (forward-sexp 1)
+    (setq post-if (point))
+    (forward-sexp -2)
+    (forward-sexp 1)
+    (setq post-B (point))
+    (cperl-backward-to-start-of-expr)
+    (setq pre-B (point))
+    (setq B (buffer-substring pre-B post-B))
+    (goto-char pre-if)
+    (forward-sexp 2)
+    (forward-sexp -1)
+    ;; May be after $, @, $# etc of a variable
+    (skip-chars-backward "$@%#")
+    (setq pre-A (point))
+    (cperl-forward-to-end-of-expr)
+    (setq post-A (point))
+    (setq A (buffer-substring pre-A post-A))
+    ;; Now modify (from end, to not break the stuff)
+    (skip-chars-forward " \t;")
+    (delete-region pre-A (point))       ; we move to pre-A
+    (insert "\n" B ";\n}")
+    (and (looking-at "[ \t]*#") (cperl-indent-for-comment))
+    (delete-region pre-if post-if)
+    (delete-region pre-B post-B)
+    (goto-char pre-B)
+    (insert if-string " (" A ") {")
+    (setq post-B (point))
+    (if (looking-at "[ \t]+$")
+        (delete-horizontal-space)
+      (if (looking-at "[ \t]*#")
+          (cperl-indent-for-comment)
+        (just-one-space)))
+    (forward-line 1)
+    (if (looking-at "[ \t]*$")
+        (progn                          ; delete line
+          (delete-horizontal-space)
+          (delete-region (point) (1+ (point)))))
+    (cperl-indent-line)
+    (goto-char (1- post-B))
+    (forward-sexp 1)
+    (cperl-indent-line)
+    (goto-char pre-B)))
+
 (defun cperl-invert-if-unless ()
-  "Change `if (A) {B}' into `B if A;' etc if possible."
+  "Change `if (A) {B}' into `B if A;' etc (or visa versa) if possible.
+If the cursor is not on the leading keyword of the BLOCK flavor of
+construct, will assume it is the STATEMENT flavor, so will try to find
+the appropriate statement modifier."
   (interactive)
-  (or (looking-at "\\<")
-      (forward-sexp -1))
+  (and (= (char-syntax (preceding-char)) ?w)
+       (forward-sexp -1))
   (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>")
-      (let ((pos1 (point))
-            pos2 pos3 pos4 pos5 s1 s2 state p pos45
-            (s0 (buffer-substring (match-beginning 0) (match-end 0))))
+      (let ((pre-if (point))
+            pre-A post-A pre-B post-B A B state p end-B-code is-block B-comment
+            (if-string (buffer-substring (match-beginning 0) (match-end 0))))
         (forward-sexp 2)
-        (setq pos3 (point))
+        (setq post-A (point))
         (forward-sexp -1)
-        (setq pos2 (point))
-        (if (eq (following-char) ?\( )
+        (setq pre-A (point))
+        (setq is-block (and (eq (following-char) ?\( )
+                            (save-excursion
+                              (condition-case nil
+                                  (progn
+                                    (forward-sexp 2)
+                                    (forward-sexp -1)
+                                    (eq (following-char) ?\{ ))
+                                (error nil)))))
+        (if is-block
             (progn
-              (goto-char pos3)
+              (goto-char post-A)
               (forward-sexp 1)
-              (setq pos5 (point))
+              (setq post-B (point))
               (forward-sexp -1)
-              (setq pos4 (point))
-              ;; XXXX In fact may be `A if (B); {C}' ...
+              (setq pre-B (point))
               (if (and (eq (following-char) ?\{ )
                        (progn
-                         (cperl-backward-to-noncomment pos3)
+                         (cperl-backward-to-noncomment post-A)
                          (eq (preceding-char) ?\) )))
                   (if (condition-case nil
                           (progn
-                            (goto-char pos5)
+                            (goto-char post-B)
                             (forward-sexp 1)
                             (forward-sexp -1)
                             (looking-at "\\<els\\(e\\|if\\)\\>"))
                         (error nil))
                       (error
-                       "`%s' (EXPR) {BLOCK} with `else'/`elsif'" s0)
-                    (goto-char (1- pos5))
-                    (cperl-backward-to-noncomment pos4)
+                       "`%s' (EXPR) {BLOCK} with `else'/`elsif'" if-string)
+                    (goto-char (1- post-B))
+                    (cperl-backward-to-noncomment pre-B)
                     (if (eq (preceding-char) ?\;)
                         (forward-char -1))
-                    (setq pos45 (point))
-                    (goto-char pos4)
-                    (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" pos45 t)
+                    (setq end-B-code (point))
+                    (goto-char pre-B)
+                    (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" end-B-code t)
                       (setq p (match-beginning 0)
-                            s1 (buffer-substring p (match-end 0))
-                            state (parse-partial-sexp pos4 p))
+                            A (buffer-substring p (match-end 0))
+                            state (parse-partial-sexp pre-B p))
                       (or (nth 3 state)
                           (nth 4 state)
                           (nth 5 state)
-                          (error "`%s' inside `%s' BLOCK" s1 s0))
+                          (error "`%s' inside `%s' BLOCK" A if-string))
                       (goto-char (match-end 0)))
                     ;; Finally got it
-                    (goto-char (1+ pos4))
+                    (goto-char (1+ pre-B))
                     (skip-chars-forward " \t\n")
-                    (setq s2 (buffer-substring (point) pos45))
-                    (goto-char pos45)
+                    (setq B (buffer-substring (point) end-B-code))
+                    (goto-char end-B-code)
                     (or (looking-at ";?[ \t\n]*}")
                         (progn
                           (skip-chars-forward "; \t\n")
-                          (setq s2 (concat s2 "\n" (buffer-substring (point) (1- pos5))))))
-                    (and (equal s2 "")
-                         (setq s2 "1"))
-                    (goto-char (1- pos3))
-                    (cperl-backward-to-noncomment pos2)
+                          (setq B-comment
+                                (buffer-substring (point) (1- post-B)))))
+                    (and (equal B "")
+                         (setq B "1"))
+                    (goto-char (1- post-A))
+                    (cperl-backward-to-noncomment pre-A)
                     (or (looking-at "[ \t\n]*)")
-                        (goto-char (1- pos3)))
+                        (goto-char (1- post-A)))
                     (setq p (point))
-                    (goto-char (1+ pos2))
+                    (goto-char (1+ pre-A))
                     (skip-chars-forward " \t\n")
-                    (setq s1 (buffer-substring (point) p))
-                    (delete-region pos4 pos5)
-                    (delete-region pos2 pos3)
-                    (goto-char pos1)
-                    (insert s2 " ")
+                    (setq A (buffer-substring (point) p))
+                    (delete-region pre-B post-B)
+                    (delete-region pre-A post-A)
+                    (goto-char pre-if)
+                    (insert B " ")
+                    (and B-comment (insert B-comment " "))
                     (just-one-space)
                     (forward-word 1)
-                    (setq pos1 (point))
-                    (insert " " s1 ";")
+                    (setq pre-A (point))
+                    (insert " " A ";")
                     (delete-horizontal-space)
+                    (setq post-B (point))
+                    (if (looking-at "#")
+                        (indent-for-comment))
+                    (goto-char post-B)
                     (forward-char -1)
                     (delete-horizontal-space)
-                    (goto-char pos1)
+                    (goto-char pre-A)
                     (just-one-space)
-                    (cperl-indent-line))
-                (error "`%s' (EXPR) not with an {BLOCK}" s0)))
-          (error "`%s' not with an (EXPR)" s0)))
-    (error "Not at `if', `unless', `while', `until', `for' or `foreach'")))
+                    (goto-char pre-if)
+                    (setq pre-A (set-marker (make-marker) pre-A))
+                    (while (<= (point) (marker-position pre-A))
+                      (cperl-indent-line)
+                      (forward-line 1))
+                    (goto-char (marker-position pre-A))
+                    (if B-comment
+                        (progn
+                          (forward-line -1)
+                          (indent-for-comment)
+                          (goto-char (marker-position pre-A)))))
+                (error "`%s' (EXPR) not with an {BLOCK}" if-string)))
+          ;; (error "`%s' not with an (EXPR)" if-string)
+          (forward-sexp -1)
+          (cperl-invert-if-unless-modifiers)))
+    ;;(error "Not at `if', `unless', `while', `until', `for' or `foreach'")
+    (cperl-invert-if-unless-modifiers)))
 
 ;;; By Anthony Foiani <afoiani@uswest.com>
 ;;; Getting help on modules in C-h f ?
 ;;; This is a modified version of `man'.
 ;;; Need to teach it how to lookup functions
+;;;###autoload
 (defun cperl-perldoc (word)
   "Run `perldoc' on WORD."
   (interactive
@@ -7103,6 +8604,7 @@ We suppose that the regexp is scanned already."
      (t
       (Man-getpage-in-background word)))))
 
+;;;###autoload
 (defun cperl-perldoc-at-point ()
   "Run a `perldoc' on the word around point."
   (interactive)
@@ -7147,7 +8649,7 @@ We suppose that the regexp is scanned already."
 (defun cperl-pod2man-build-command ()
   "Builds the entire background manpage and cleaning command."
   (let ((command (concat pod2man-program " %s 2>/dev/null"))
-        (flist Man-filter-list))
+        (flist (and (boundp 'Man-filter-list) Man-filter-list)))
     (while (and flist (car flist))
       (let ((pcom (car (car flist)))
             (pargs (cdr (car flist))))
@@ -7161,6 +8663,205 @@ We suppose that the regexp is scanned already."
         (setq flist (cdr flist))))
     command))
 
+
+(defun cperl-next-interpolated-REx-1 ()
+  "Move point to next REx which has interpolated parts without //o.
+Skips RExes consisting of one interpolated variable.
+
+Note that skipped RExen are not performance hits."
+  (interactive "")
+  (cperl-next-interpolated-REx 1))
+
+(defun cperl-next-interpolated-REx-0 ()
+  "Move point to next REx which has interpolated parts without //o."
+  (interactive "")
+  (cperl-next-interpolated-REx 0))
+
+(defun cperl-next-interpolated-REx (&optional skip beg limit)
+  "Move point to next REx which has interpolated parts.
+SKIP is a list of possible types to skip, BEG and LIMIT are the starting
+point and the limit of search (default to point and end of buffer).
+
+SKIP may be a number, then it behaves as list of numbers up to SKIP; this
+semantic may be used as a numeric argument.
+
+Types are 0 for / $rex /o (interpolated once), 1 for /$rex/ (if $rex is
+a result of qr//, this is not a performance hit), t for the rest."
+  (interactive "P")
+  (if (numberp skip) (setq skip (list 0 skip)))
+  (or beg (setq beg (point)))
+  (or limit (setq limit (point-max)))   ; needed for n-s-p-c
+  (let (pp)
+    (and (eq (get-text-property beg 'syntax-type) 'string)
+         (setq beg (next-single-property-change beg 'syntax-type nil limit)))
+    (cperl-map-pods-heres
+     (function (lambda (s e p)
+                 (if (memq (get-text-property s 'REx-interpolated) skip)
+                     t
+                   (setq pp s)
+                   nil)))       ; nil stops
+     'REx-interpolated beg limit)
+    (if pp (goto-char pp)
+      (message "No more interpolated REx"))))
+
+;;; Initial version contributed by Trey Belew
+(defun cperl-here-doc-spell (&optional beg end)
+  "Spell-check HERE-documents in the Perl buffer.
+If a region is highlighted, restricts to the region."
+  (interactive "")
+  (cperl-pod-spell t beg end))
+
+(defun cperl-pod-spell (&optional do-heres beg end)
+  "Spell-check POD documentation.
+If invoked with prefix argument, will do HERE-DOCs instead.
+If a region is highlighted, restricts to the region."
+  (interactive "P")
+  (save-excursion
+    (let (beg end)
+      (if (cperl-mark-active)
+          (setq beg (min (mark) (point))
+                end (max (mark) (point)))
+        (setq beg (point-min)
+              end (point-max)))
+      (cperl-map-pods-heres (function
+                             (lambda (s e p)
+                               (if do-heres
+                                   (setq e (save-excursion
+                                             (goto-char e)
+                                             (forward-line -1)
+                                             (point))))
+                               (ispell-region s e)
+                               t))
+                            (if do-heres 'here-doc-group 'in-pod)
+                            beg end))))
+
+(defun cperl-map-pods-heres (func &optional prop s end)
+  "Executes a function over regions of pods or here-documents.
+PROP is the text-property to search for; default to `in-pod'.  Stop when
+function returns nil."
+  (let (pos posend has-prop (cont t))
+    (or prop (setq prop 'in-pod))
+    (or s (setq s (point-min)))
+    (or end (setq end (point-max)))
+    (cperl-update-syntaxification end end)
+    (save-excursion
+      (goto-char (setq pos s))
+      (while (and cont (< pos end))
+        (setq has-prop (get-text-property pos prop))
+        (setq posend (next-single-property-change pos prop nil end))
+        (and has-prop
+             (setq cont (funcall func pos posend prop)))
+        (setq pos posend)))))
+
+;;; Based on code by Masatake YAMATO:
+(defun cperl-get-here-doc-region (&optional pos pod)
+  "Return HERE document region around the point.
+Return nil if the point is not in a HERE document region.  If POD is non-nil,
+will return a POD section if point is in a POD section."
+  (or pos (setq pos (point)))
+  (cperl-update-syntaxification pos pos)
+  (if (or (eq 'here-doc  (get-text-property pos 'syntax-type))
+          (and pod
+               (eq 'pod (get-text-property pos 'syntax-type))))
+      (let ((b (cperl-beginning-of-property pos 'syntax-type))
+            (e (next-single-property-change pos 'syntax-type)))
+        (cons b (or e (point-max))))))
+
+(defun cperl-narrow-to-here-doc (&optional pos)
+  "Narrows editing region to the HERE-DOC at POS.
+POS defaults to the point."
+  (interactive "d")
+  (or pos (setq pos (point)))
+  (let ((p (cperl-get-here-doc-region pos)))
+    (or p (error "Not inside a HERE document"))
+    (narrow-to-region (car p) (cdr p))
+    (message
+     "When you are finished with narrow editing, type C-x n w")))
+
+(defun cperl-select-this-pod-or-here-doc (&optional pos)
+  "Select the HERE-DOC (or POD section) at POS.
+POS defaults to the point."
+  (interactive "d")
+  (let ((p (cperl-get-here-doc-region pos t)))
+    (if p
+        (progn
+          (goto-char (car p))
+          (push-mark (cdr p) nil t))    ; Message, activate in transient-mode
+      (message "I do not think POS is in POD or a HERE-doc..."))))
+
+(defun cperl-facemenu-add-face-function (face end)
+  "A callback to process user-initiated font-change requests.
+Translates `bold', `italic', and `bold-italic' requests to insertion of
+corresponding POD directives, and `underline' to C<> POD directive.
+
+Such requests are usually bound to M-o LETTER."
+  (or (get-text-property (point) 'in-pod)
+      (error "Faces can only be set within POD"))
+  (setq facemenu-end-add-face (if (eq face 'bold-italic) ">>" ">"))
+  (cdr (or (assq face '((bold . "B<")
+                        (italic . "I<")
+                        (bold-italic . "B<I<")
+                        (underline . "C<")))
+           (error "Face %s not configured for cperl-mode"
+                  face))))
+
+(defun cperl-time-fontification (&optional l step lim)
+  "Times how long it takes to do incremental fontification in a region.
+L is the line to start at, STEP is the number of lines to skip when
+doing next incremental fontification, LIM is the maximal number of
+incremental fontification to perform.  Messages are accumulated in
+*Messages* buffer.
+
+May be used for pinpointing which construct slows down buffer fontification:
+start with default arguments, then refine the slowdown regions."
+  (interactive "nLine to start at: \nnStep to do incremental fontification: ")
+  (or l (setq l 1))
+  (or step (setq step 500))
+  (or lim (setq lim 40))
+  (let* ((timems (function (lambda ()
+                             (let ((tt (current-time)))
+                               (+ (* 1000 (nth 1 tt)) (/ (nth 2 tt) 1000))))))
+         (tt (funcall timems)) (c 0) delta tot)
+    (goto-line l)
+    (cperl-mode)
+    (setq tot (- (- tt (setq tt (funcall timems)))))
+    (message "cperl-mode at %s: %s" l tot)
+    (while (and (< c lim) (not (eobp)))
+      (forward-line step)
+      (setq l (+ l step))
+      (setq c (1+ c))
+      (cperl-update-syntaxification (point) (point))
+      (setq delta (- (- tt (setq tt (funcall timems)))) tot (+ tot delta))
+      (message "to %s:%6s,%7s" l delta tot))
+    tot))
+
+(defun cperl-emulate-lazy-lock (&optional window-size)
+  "Emulate `lazy-lock' without `condition-case', so `debug-on-error' works.
+Start fontifying the buffer from the start (or end) using the given
+WINDOW-SIZE (units is lines).  Negative WINDOW-SIZE starts at end, and
+goes backwards; default is -50.  This function is not CPerl-specific; it
+may be used to debug problems with delayed incremental fontification."
+  (interactive
+   "nSize of window for incremental fontification, negative goes backwards: ")
+  (or window-size (setq window-size -50))
+  (let ((pos (if (> window-size 0)
+                 (point-min)
+               (point-max)))
+        p)
+    (goto-char pos)
+    (normal-mode)
+    ;; Why needed???  With older font-locks???
+    (set (make-local-variable 'font-lock-cache-position) (make-marker))
+    (while (if (> window-size 0)
+               (< pos (point-max))
+             (> pos (point-min)))
+      (setq p (progn
+                (forward-line window-size)
+                (point)))
+      (font-lock-fontify-region (min p pos) (max p pos))
+      (setq pos p))))
+
+
 (defun cperl-lazy-install ())           ; Avoid a warning
 (defun cperl-lazy-unstall ())           ; Avoid a warning
 
@@ -7176,7 +8877,7 @@ We suppose that the regexp is scanned already."
         "Switches on Auto-Help on Perl constructs (put in the message area).
 Delay of auto-help controlled by `cperl-lazy-help-time'."
         (interactive)
-        (make-variable-buffer-local 'cperl-help-shown)
+        (make-local-variable 'cperl-help-shown)
         (if (and (cperl-val 'cperl-lazy-help-time)
                  (not cperl-lazy-installed))
             (progn
@@ -7209,48 +8910,109 @@ Delay of auto-help controlled by `cperl-lazy-help-time'."
 ;;; Plug for wrong font-lock:
 
 (defun cperl-font-lock-unfontify-region-function (beg end)
-  ;; Simplified now that font-lock-unfontify-region uses save-buffer-state.
-  (let (before-change-functions after-change-functions)
-    (remove-text-properties beg end '(face nil))))
+  (let* ((modified (buffer-modified-p)) (buffer-undo-list t)
+         (inhibit-read-only t) (inhibit-point-motion-hooks t)
+         before-change-functions after-change-functions
+         deactivate-mark buffer-file-name buffer-file-truename)
+    (remove-text-properties beg end '(face nil))
+    (if (and (not modified) (buffer-modified-p))
+      (set-buffer-modified-p nil))))
+
+(defun cperl-font-lock-fontify-region-function (beg end loudly)
+  "Extends the region to safe positions, then calls the default function.
+Newer `font-lock's can do it themselves.
+We unwind only as far as needed for fontification.  Syntaxification may
+do extra unwind via `cperl-unwind-to-safe'."
+  (save-excursion
+    (goto-char beg)
+    (while (and beg
+                (progn
+                  (beginning-of-line)
+                  (eq (get-text-property (setq beg (point)) 'syntax-type)
+                      'multiline)))
+      (if (setq beg (cperl-beginning-of-property beg 'syntax-type))
+          (goto-char beg)))
+    (setq beg (point))
+    (goto-char end)
+    (while (and end
+                (progn
+                  (or (bolp) (condition-case nil
+                                 (forward-line 1)
+                               (error nil)))
+                  (eq (get-text-property (setq end (point)) 'syntax-type)
+                      'multiline)))
+      (setq end (next-single-property-change end 'syntax-type nil (point-max)))
+      (goto-char end))
+    (setq end (point)))
+  (font-lock-default-fontify-region beg end loudly))
 
 (defvar cperl-d-l nil)
 (defun cperl-fontify-syntaxically (end)
   ;; Some vars for debugging only
   ;; (message "Syntaxifying...")
-  (let ((dbg (point)) (iend end)
+  (let ((dbg (point)) (iend end) (idone cperl-syntax-done-to)
         (istate (car cperl-syntax-state))
-        start)
-    (and cperl-syntaxify-unwind
-         (setq end (cperl-unwind-to-safe t end)))
-    (setq start (point))
+        start from-start edebug-backtrace-buffer)
+    (if (eq cperl-syntaxify-by-font-lock 'backtrace)
+        (progn
+          (require 'edebug)
+          (let ((f 'edebug-backtrace))
+            (funcall f))))      ; Avoid compile-time warning
     (or cperl-syntax-done-to
-        (setq cperl-syntax-done-to (point-min)))
-    (if (or (not (boundp 'font-lock-hot-pass))
-            (eval 'font-lock-hot-pass)
-            t)                          ; Not debugged otherwise
-        ;; Need to forget what is after `start'
-        (setq start (min cperl-syntax-done-to start))
-      ;; Fontification without a change
-      (setq start (max cperl-syntax-done-to start)))
+        (setq cperl-syntax-done-to (point-min)
+              from-start t))
+    (setq start (if (and cperl-hook-after-change
+                         (not from-start))
+                    cperl-syntax-done-to ; Fontify without change; ignore start
+                  ;; Need to forget what is after `start'
+                  (min cperl-syntax-done-to (point))))
+    (goto-char start)
+    (beginning-of-line)
+    (setq start (point))
+    (and cperl-syntaxify-unwind
+         (setq end (cperl-unwind-to-safe t end)
+               start (point)))
     (and (> end start)
          (setq cperl-syntax-done-to start) ; In case what follows fails
          (cperl-find-pods-heres start end t nil t))
-    (if (eq cperl-syntaxify-by-font-lock 'message)
-        (message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s"
-                 dbg iend
-                 start end cperl-syntax-done-to
+    (if (memq cperl-syntaxify-by-font-lock '(backtrace message))
+        (message "Syxify req=%s..%s actual=%s..%s done-to: %s=>%s statepos: %s=>%s"
+                 dbg iend start end idone cperl-syntax-done-to
                  istate (car cperl-syntax-state))) ; For debugging
     nil))                               ; Do not iterate
 
 (defun cperl-fontify-update (end)
-  (let ((pos (point)) prop posend)
+  (let ((pos (point-min)) prop posend)
+    (setq end (point-max))
     (while (< pos end)
-      (setq prop (get-text-property pos 'cperl-postpone))
-      (setq posend (next-single-property-change pos 'cperl-postpone nil end))
+      (setq prop (get-text-property pos 'cperl-postpone)
+            posend (next-single-property-change pos 'cperl-postpone nil end))
       (and prop (put-text-property pos posend (car prop) (cdr prop)))
       (setq pos posend)))
   nil)                                  ; Do not iterate
 
+(defun cperl-fontify-update-bad (end)
+  ;; Since fontification happens with different region than syntaxification,
+  ;; do to the end of buffer, not to END;;; likewise, start earlier if needed
+  (let* ((pos (point)) (prop (get-text-property pos 'cperl-postpone)) posend)
+    (if prop
+        (setq pos (or (cperl-beginning-of-property
+                       (cperl-1+ pos) 'cperl-postpone)
+                      (point-min))))
+    (while (< pos end)
+      (setq posend (next-single-property-change pos 'cperl-postpone))
+      (and prop (put-text-property pos posend (car prop) (cdr prop)))
+      (setq pos posend)
+      (setq prop (get-text-property pos 'cperl-postpone))))
+  nil)                                  ; Do not iterate
+
+;; Called when any modification is made to buffer text.
+(defun cperl-after-change-function (beg end old-len)
+  ;; We should have been informed about changes by `font-lock'.  Since it
+  ;; does not inform as which calls are defered, do it ourselves
+  (if cperl-syntax-done-to
+      (setq cperl-syntax-done-to (min cperl-syntax-done-to beg))))
+
 (defun cperl-update-syntaxification (from to)
   (if (and cperl-use-syntax-table-text-property
            cperl-syntaxify-by-font-lock
@@ -7262,7 +9024,7 @@ Delay of auto-help controlled by `cperl-lazy-help-time'."
           (cperl-fontify-syntaxically to)))))
 
 (defvar cperl-version
-  (let ((v  "Revision: 5.0"))
+  (let ((v  "Revision: 5.22"))
     (string-match ":\\s *\\([0-9.]+\\)" v)
     (substring v (match-beginning 1) (match-end 1)))
   "Version of IZ-supported CPerl package this file is based on.")