]> git.eshelyaron.com Git - emacs.git/commitdiff
Merge from upstream, upto version 5.22.
authorStefan Monnier <monnier@iro.umontreal.ca>
Wed, 11 Oct 2006 06:47:35 +0000 (06:47 +0000)
committerStefan Monnier <monnier@iro.umontreal.ca>
Wed, 11 Oct 2006 06:47:35 +0000 (06:47 +0000)
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

lisp/progmodes/cperl-mode.el

index 69f4549a0bf88cc32cbcd21d18f64505c9964042..3264e0e72f6ecc6d0a4e07f0891f4991a42b6ca6 100644 (file)
@@ -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:
 
 ;; likewise with m, tr, y, q, qX instead of s
 
 ;;; Code:
-
+\f
 (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)
 
 \f
 
@@ -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
+
+")
 
 \f
 
@@ -985,6 +1068,25 @@ the faces: please specify bold, italic, underline, shadow and box.)
    (cperl-hairy (or hairy t))
    (t (symbol-value symbol))))
 \f
+
+(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 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
 
 \f
 (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)) 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))))
+\f
+(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))))
+
+\f
 (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.")