* update cperl mode

diff --git a/emacs_el/cperl-mode.el b/emacs_el/cperl-mode.el
index 1cc2f17de50d439b16a76f15bcf75269405b06db..e9ef08549724612c436463464feeca21e32b5511 100644 (file)
--- a/emacs_el/cperl-mode.el
+++ b/emacs_el/cperl-mode.el
@@ -45,7 +45,7 @@
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;; $Id: cperl-mode.el,v 5.16 2006/02/21 11:18:21 vera Exp vera $
+;; $Id: cperl-mode.el,v 5.19 2006/06/01 11:11:57 vera Exp vera $

 
 ;;; If your Emacs does not default to `cperl-mode' on Perl files:
 ;;; To use this mode put the following into
 
 ;;; If your Emacs does not default to `cperl-mode' on Perl files:
 ;;; To use this mode put the following into


@@ -1401,6 +1401,54 @@
 ;;;                            Highlight many others 0-length builtins
 ;;; `cperl-praise':            Mention indenting and highlight in RExen.
 
 ;;;                            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.
+

 ;;; Code:
 \f
 (if (fboundp 'eval-when-compile)
 ;;; Code:
 \f
 (if (fboundp 'eval-when-compile)


@@ -1956,6 +2004,7 @@ This way enabling/disabling of menu items is more correct."
     (font-lock-string-face             nil nil         italic underline)
     (cperl-nonoverridable-face         nil nil         italic underline)
     (font-lock-type-face               nil nil         underline)
     (font-lock-string-face             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
     (underline                         nil "LightGray" strikeout))
   "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
   :type '(repeat (cons symbol


@@ -2268,7 +2317,8 @@ voice);
           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
           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.
+          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
 
 5) The indentation engine was very smart, but most of tricks may be
 not needed anymore with the support for `syntax-table' property.  Has


@@ -2286,7 +2336,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
 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
 
 (defvar cperl-speed 'please-ignore-this-line
   "This is an incomplete compendium of what is available in other parts


@@ -2341,8 +2394,8 @@ B) Speed of editing operations.
                                syntaxically to be not code
   `font-lock-constant-face'    HERE-doc delimiters, labels, delimiters of
                                2-arg operators s/y/tr/ or of RExen,
                                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
                                subroutine names at the moment of definition
                                (except those conflicting with Perl operators),
                                package names (when recognized), format names


@@ -2365,7 +2418,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.)
 
 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
 
 
 \f
 


@@ -2521,6 +2592,9 @@ versions of Emacs."
   (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-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 "\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)


@@ -2608,7 +2682,17 @@ versions of Emacs."
          ["Contract a group" cperl-contract-level
           cperl-use-syntax-table-text-property]
          ["Contract groups" cperl-contract-levels
          ["Contract a group" cperl-contract-level
           cperl-use-syntax-table-text-property]
          ["Contract groups" cperl-contract-levels

-          cperl-use-syntax-table-text-property])
+          cperl-use-syntax-table-text-property]
+         "----"
+         ["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]
         "----"
         ["Insert spaces if needed to fix style" cperl-find-bad-style t]
         ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
         "----"


@@ -3151,6 +3235,18 @@ or as help on variables `cperl-tips', `cperl-problems',
   (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
                            (` ((SCCS (, (car cperl-vc-sccs-header)))
                                     (RCS (, (car cperl-vc-rcs-header)))))))
   (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)))
+        (let ((f 'compilation-build-compilation-error-regexp-alist))
+          (funcall f)))
+       ((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
   (make-local-variable 'font-lock-defaults)
   (setq        font-lock-defaults
        (cond


@@ -4862,6 +4958,9 @@ Works before syntax recognition is done."
 ;;             (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'.
 ;;      f) Multiline my/our declaration lists etc: `syntax-type' => `multiline'
 
 ;;             (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)
 (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)


@@ -4897,9 +4996,15 @@ Works before syntax recognition is done."
                           (setq end (point)))))
          (or end pos)))))
 
                           (setq end (point)))))
          (or end pos)))))
 

+;;; These are needed for byte-compile (at least with v19)

 (defvar cperl-nonoverridable-face)
 (defvar cperl-nonoverridable-face)

+(defvar font-lock-variable-name-face)

 (defvar font-lock-function-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-comment-face)

+(defvar font-lock-warning-face)

 
 (defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
   "Syntaxically mark (and fontify) attributes of a subroutine.
 
 (defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
   "Syntaxically mark (and fontify) attributes of a subroutine.


@@ -4941,7 +5046,8 @@ Should be called with the point before leading colon of an attribute."
          (setq after-first t))
       (error (message
              "L%d: attribute `%s': %s"
          (setq after-first t))
       (error (message
              "L%d: attribute `%s': %s"

-             (count-lines (point-min) (point)) (buffer-substring start1 end1) b)
+             (count-lines (point-min) (point))
+             (and start1 end1 (buffer-substring start1 end1)) b)

             (setq start nil)))
     (and start
         (progn
             (setq start nil)))
     (and start
         (progn


@@ -4972,7 +5078,7 @@ Should be called with the point before leading colon of an attribute."
       (if (eq ?\{ (preceding-char)) nil
        (cperl-postpone-fontification
         (1- (point)) (point)
       (if (eq ?\{ (preceding-char)) nil
        (cperl-postpone-fontification
         (1- (point)) (point)

-        'face font-lock-function-name-face))))
+        '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)
 
 ;;; 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)


@@ -4989,7 +5095,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
         face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
         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)
         face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
         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)) overshoot
+        (modified (buffer-modified-p)) overshoot is-o-REx

         (after-change-functions nil)
         (cperl-font-locking t)
         (use-syntax-state (and cperl-syntax-state
         (after-change-functions nil)
         (cperl-font-locking t)
         (use-syntax-state (and cperl-syntax-state


@@ -5002,24 +5108,53 @@ 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...
         ;; (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-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-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))
          (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))
         (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-face))
          (if (boundp 'cperl-nonoverridable-face)
              cperl-nonoverridable-face
            '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))
         (stop-point (if ignore-max
                         (point-max)
                       max))


@@ -5090,6 +5225,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
            (remove-text-properties min max
                                    '(syntax-type t in-pod t syntax-table t
                                                  attrib-group t
            (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
                                                  cperl-postpone t
                                                  syntax-subtype t
                                                  rear-nonsticky t


@@ -5169,6 +5305,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                         (remove-text-properties
                          max e '(syntax-type t in-pod t syntax-table t
                                              attrib-group t
                         (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
                                              cperl-postpone t
                                              syntax-subtype t
                                              here-doc-group t


@@ -5256,7 +5393,15 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                         (cond
                                          ((looking-at "[0-9$({]")
                                           (forward-sexp 1)
                                         (cond
                                          ((looking-at "[0-9$({]")
                                           (forward-sexp 1)

-                                          (looking-at "[ \t]*<<")))))
+                                          (and
+                                           (looking-at "[ \t]*<<")
+                                           (condition-case nil
+                                               ;; print $foo <<EOF
+                                               (progn
+                                                 (forward-sexp -2)
+                                                 (not
+                                                  (looking-at "print\\>")))
+                                               (error t)))))))

                                   (error nil))) ; func(<<EOF)
                               (and (not (match-beginning 6)) ; Empty
                                    (looking-at
                                   (error nil))) ; func(<<EOF)
                               (and (not (match-beginning 6)) ; Empty
                                    (looking-at


@@ -5273,7 +5418,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                        qtag (regexp-quote tag))
                  (cond (cperl-pod-here-fontify
                         ;; Highlight the starting delimiter
                        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))
                         (cperl-put-do-not-fontify b1 e1 t)))
                  (forward-line)
                  (setq i (point))


@@ -5293,8 +5439,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                  (if cperl-pod-here-fontify
                      (progn
                        ;; Highlight the ending delimiter
                  (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)
                        (cperl-put-do-not-fontify b (match-end 0) t)
                        ;; Highlight the HERE-DOC
                        (cperl-postpone-fontification b (match-beginning 0)


@@ -5534,7 +5681,7 @@ 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
                                 (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
                  ;; If s{} (), then b/b1 are at "{", "(", e1/i after ")", "}"
                  ;; Commenting \\ is dangerous, what about ( ?
                  (and i tail


@@ -5543,6 +5690,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                  (and (if go (looking-at ".\\sw*x")
                         (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
                  (if (null i)
                      ;; Considered as 1arg form
                      (progn


@@ -5586,7 +5736,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
                        (forward-word 1) ; skip modifiers s///s
                        (if tail (cperl-commentify tail (point) t))
                        (cperl-postpone-fontification

-                        e1 (point) 'face 'cperl-nonoverridable-face)))
+                        e1 (point) 'face my-cperl-REx-modifiers-face)))

                  ;; Check whether it is m// which means "previous match"
                  ;; and highlight differently
                  (setq is-REx
                  ;; Check whether it is m// which means "previous match"
                  ;; and highlight differently
                  (setq is-REx


@@ -5604,7 +5754,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                   (not (looking-at "split\\>")))
                               (error t))))
                      (cperl-postpone-fontification
                                   (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
                    (if (or i2          ; Has 2 args
                            (and cperl-fontify-m-as-s
                                 (or


@@ -5613,11 +5763,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                       (not (eq ?\< (char-after b)))))))
                        (progn
                          (cperl-postpone-fontification
                                       (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
                          (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: embedded comments, charclasses and ]
                    (if (and is-REx cperl-regexp-scan)
                        ;; 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 
                        (save-excursion
                          (goto-char (1+ b))
                          ;; First 


@@ -5636,12 +5792,33 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                    "\\(\\[\\)" ; 3=[
                                 "\\|"
                                    "\\(]\\)" ; 4=]
                                    "\\(\\[\\)" ; 3=[
                                 "\\|"
                                    "\\(]\\)" ; 4=]

-                                "\\|"  ; 5=builtin 0-length, 6
+                                "\\|"
+                                ;; 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?
                                    ;; XXXX: what if u is delim?

-                                   "\\("
-                                      "[)^$|]"

                                    "\\|"
                                    "\\|"

-                                      "[*?+]" ; Do not need \?? !
+                                      "[)^|$.*?+]"

                                    "\\|"
                                       "{[0-9]+}"
                                    "\\|"
                                    "\\|"
                                       "{[0-9]+}"
                                    "\\|"


@@ -5649,232 +5826,287 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                    "\\|"
                                       "\\\\[luLUEQbBAzZG]"
                                    "\\|"
                                    "\\|"
                                       "\\\\[luLUEQbBAzZG]"
                                    "\\|"

-                                      "("
-                                      "\\("
-                                         "\\?[:=!>]"
+                                      "(" ; Group opener
+                                      "\\(" ; 10 group opener follower
+                                         "\\?\\((\\?\\)" ; 11: in (?(?=C)A|B)
+                                      "\\|"
+                                         "\\?[:=!>?{]" ; "?" something

                                       "\\|"
                                          "\\?[-imsx]+[:)]" ; (?i) (?-s:.)
                                       "\\|"
                                          "\\?([0-9]+)" ; (?(1)foo|bar)
                                       "\\|"
                                          "\\?<[=!]"
                                       "\\|"
                                          "\\?[-imsx]+[:)]" ; (?i) (?-s:.)
                                       "\\|"
                                          "\\?([0-9]+)" ; (?(1)foo|bar)
                                       "\\|"
                                          "\\?<[=!]"

-                                      "\\|"
-                                         "\\?" ; (?(?=foo)bar|baz)
+                                      ;;;"\\|"
+                                      ;;;   "\\?"

                                       "\\)?"
                                    "\\)"
                                       "\\)?"
                                    "\\)"

-                                ;; XXXX Need {5,6}?

                                 "\\|"
                                 "\\|"

-                                   "\\\\\\(.\\)" ; 7=\SYMBOL
-                                ;; XXXX Will not be able to use it in s)))
-                                (if (eq (char-after b) ?\) ) ""
-                                  (concat
-                                   "\\|"
-                                   (if (eq (char-after b) ?? ) ; 8 = (?{
-                                       "\\((\\\\\\?\\(\\\\\\?\\)?{\\)"
-                                     "\\((\\?\\(\\?\\)?{\\)"))))) ; 8 = opt ?
+                                   "\\\\\\(.\\)" ; 12=\SYMBOL
+                                ))

                          (while
                              (and (< (point) (1- e))
                                   (re-search-forward hairy-RE (1- e) 'to-end))
                            (goto-char (match-beginning 0))
                            (setq REx-subgr-start (point)
                          (while
                              (and (< (point) (1- e))
                                   (re-search-forward hairy-RE (1- e) 'to-end))
                            (goto-char (match-beginning 0))
                            (setq REx-subgr-start (point)

-                                 was-subgr t)
-                           (if (save-excursion
-                                 (and
-                                  nil  ; Not needed now, when we skip \SYMBOL
-                                  (/= (1+ b) (point)) ; \ may be delim
-                                  (eq (preceding-char) ?\\)
-                                  (= (% (skip-chars-backward "\\\\") 2)
-                                     (if (and (eq (char-after b) ?\#)
-                                              (eq (following-char) ?\#))
-                                         0
-                                       -1))))
-                               ;; Not a subgr, avoid loop:
-                               (progn (setq was-subgr nil)
-                                      (forward-char 1))
-                             (cond
-                              ((match-beginning 5) ; 0-length builtins
-                               (setq was-subgr nil) ; We do stuff here
-                               (goto-char (match-end 5))
-                               (if (>= (point) e)
-                                   (goto-char (1- e)))
+                                 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
                                (cperl-postpone-fontification

-                                (match-beginning 5) (point)
-                                'face font-lock-variable-name-face)
-                               (if (and (memq (string-to-char (match-string 5))
-                                              (append "(|" nil))
-                                        (not (string-match "(\?[-imsx]+)"
-                                                           (match-string 5))))
-                                   (cperl-look-at-leading-count is-x-REx e)))
-                              ((match-beginning 7) ; \SYMBOL
-                               (forward-char 2)
-                               (if (>= (point) e)
-                                   (goto-char (1- e))
-                                 ;; 0-len special-alnums in other branch =>
-                                 ;; Generic:  \non-alnum (1), \alnum NO
-                                 ;; Is-delim: \non-alnum (1/spec-2) alnum-1 (=what hai)
-                                 ;; How many chars to not highlight
-                                 (setq was-subgr (if (eq (char-after b)
-                                                         (string-to-char
-                                                          (match-string 7)))
-                                                     (if (string-match
-                                                          "[][)^$|*?+]"
-                                                          (match-string 7))
-                                                         0
-                                                       1)
-                                                   (if (string-match
-                                                        "[a-zA-Z0-9]"
-                                                        (match-string 7))
-                                                       nil
-                                                     1)))
-                                 (if was-subgr
+                                (- (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
                                      (cperl-postpone-fontification

-                                      (- (point) 2) (- (point) was-subgr)
-                                      'face font-lock-variable-name-face)))
-                               (setq was-subgr nil)) ; We do stuff here
-                              ((match-beginning 3) ; [charclass]
-                               ;; Mismatch for /$patterns->[1]/
-                               (forward-char 1)
-                               (setq qtag 0) ; leaders
-                               (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 [\\]]
+                                      (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+:]\\|\\[[^:]\\)*]")
 ;;; POSIX?  [:word:] [:^word:] only inside []
 ;;;                                   "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]")

-                               (while 
-                                   (and argument
-                                        (re-search-forward
-                                         (if (eq (char-after b) ?\] )
-                                             "\\=\\(\\\\[^]]\\|[^]\\\\]\\)*\\\\]"
-                                           "\\=\\(\\\\.\\|[^]\\\\]\\)*]")
-                                         (1- e) 'toend))
-                                        ;; Is this ] the 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))
+                             (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
                                (cperl-postpone-fontification

-                                REx-subgr-start qtag
+                                (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
+                                   (goto-char (1- e))
+                                   (message qtag))
+                               (cperl-postpone-fontification
+                                (1- tag) (1- (point))

                                 'face font-lock-variable-name-face)
                                (cperl-postpone-fontification
                                 'face font-lock-variable-name-face)
                                (cperl-postpone-fontification

-                                (if (eq (char-after b) ?\] )
-                                    (- (point) 2)
-                                  (1- (point)))
-                                (point) 'face font-lock-variable-name-face)
-                               (while tag
-                                 (cperl-postpone-fontification
-                                  (car (car tag)) (cdr (car tag))
-                                  'face font-lock-type-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))
+                                REx-subgr-start (1- tag)
+                                'face my-cperl-REx-spec-char-face)

                                (cperl-postpone-fontification
                                 (1- (point)) (point)
                                (cperl-postpone-fontification
                                 (1- (point)) (point)

-                                'face font-lock-function-name-face))
-                              ((match-beginning 8) ; (?{})
-                               (setq was-subgr (point)
-                                     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 })")))
+                                'face my-cperl-REx-spec-char-face)
+                               (if cperl-use-syntax-table-text-property

                                    (progn
                                    (progn

-                                     (goto-char (1- e))
-                                     (message qtag))
-                                 (cperl-postpone-fontification
-                                  (1- tag) (1- (point))
-                                  'face font-lock-variable-name-face)
-                                 (if cperl-use-syntax-table-text-property
-                                     (progn
-                                       (put-text-property
-                                        (1- (point)) (point)
-                                        'syntax-table cperl-st-cfence)
-                                       (put-text-property
-                                        was-subgr (1+ was-subgr)
-                                        '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)))))
+                                     (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)))
                            (cond
                            (if (>= (point) e)
                                (goto-char (1- e)))
                            (cond

-                            ((eq was-subgr t)
+                            (was-subgr

                              (setq REx-subgr-end (point))
                              (cperl-commentify
                               REx-subgr-start REx-subgr-end nil)
                              (setq REx-subgr-end (point))
                              (cperl-commentify
                               REx-subgr-start REx-subgr-end nil)


@@ -5887,11 +6119,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                  (if i2
                      (progn
                        (cperl-postpone-fontification
                  (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)
                            (progn
                              (cperl-postpone-fontification
                        (if (assoc (char-after b) cperl-starters)
                            (progn
                              (cperl-postpone-fontification

-                              b1 (1+ b1) 'face font-lock-constant-face)
+                              b1 (1+ b1) 'face my-cperl-delimiters-face)

                              (put-text-property b1 (1+ b1)
                                           'REx-part2 t)))))
                  (if (> (point) max)
                              (put-text-property b1 (1+ b1)
                                           'REx-part2 t)))))
                  (if (> (point) max)


@@ -6102,6 +6334,36 @@ CHARS is a string that contains good characters to have before us (however,
                       (eq (get-text-property (point) 'syntax-type)
                           'format)))))))))
 
                       (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)))
+    (error nil)))
+
+(defun cperl-at-end-of-expr (&optional lim)
+  (condition-case nil
+      (save-excursion
+       ;; If nothing interesting after, same as (forward-sexp -1); otherwise
+       ;; fails, or at a start of following sexp:
+       (let ((p (point)))
+         (forward-sexp 1)
+         (forward-sexp -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))
 (defun cperl-backward-to-start-of-continued-exp (lim)
   (if (memq (preceding-char) (append ")]}\"'`" nil))
       (forward-sexp -1))


@@ -6787,9 +7049,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
   ;; 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
 
 (defun cperl-init-faces ()
   (condition-case errs


@@ -7118,6 +7383,14 @@ indentation and initial hashes.  Behaves usually outside of comment."
                      [nil              nil             t               t       t]
                      nil
                      [nil              nil             t               t       t])
                      [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
                (list 'font-lock-constant-face
                      ["CadetBlue"      "Aquamarine"    "Gray50"        "LightGray"]
                      nil


@@ -7163,6 +7436,8 @@ indentation and initial hashes.  Behaves usually outside of comment."
                            "Face for data types")
          (cperl-force-face cperl-nonoverridable-face
                            "Face for data types from another group")
                            "Face for data types")
          (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
          (cperl-force-face font-lock-comment-face
                            "Face for comments")
          (cperl-force-face font-lock-function-name-face


@@ -9285,91 +9560,189 @@ We suppose that the regexp is scanned already."
       (set-marker e (1- (point)))
       (cperl-beautify-regexp-piece b e nil deep))))
 
       (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)
+    (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 ()
 (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)
   (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\\)\\>")
   (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)
        (forward-sexp 2)

-       (setq pos3 (point))
+       (setq post-A (point))

        (forward-sexp -1)
        (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
            (progn

-             (goto-char pos3)
+             (goto-char post-A)

              (forward-sexp 1)
              (forward-sexp 1)

-             (setq pos5 (point))
+             (setq post-B (point))

              (forward-sexp -1)
              (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
              (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
                         (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
                            (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))
                    (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)
                      (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)
                      (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 (match-end 0)))
                    ;; Finally got it

-                   (goto-char (1+ pos4))
+                   (goto-char (1+ pre-B))

                    (skip-chars-forward " \t\n")
                    (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")
                    (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]*)")
                    (or (looking-at "[ \t\n]*)")

-                       (goto-char (1- pos3)))
+                       (goto-char (1- post-A)))

                    (setq p (point))
                    (setq p (point))

-                   (goto-char (1+ pos2))
+                   (goto-char (1+ pre-A))

                    (skip-chars-forward " \t\n")
                    (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)
                    (just-one-space)
                    (forward-word 1)

-                   (setq pos1 (point))
-                   (insert " " s1 ";")
+                   (setq pre-A (point))
+                   (insert " " A ";")

                    (delete-horizontal-space)
                    (delete-horizontal-space)

+                   (setq post-B (point))
+                   (if (looking-at "#")
+                       (indent-for-comment))
+                   (goto-char post-B)

                    (forward-char -1)
                    (delete-horizontal-space)
                    (forward-char -1)
                    (delete-horizontal-space)

-                   (goto-char pos1)
+                   (goto-char pre-A)

                    (just-one-space)
                    (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 ?
 
 ;;; By Anthony Foiani <afoiani@uswest.com>
 ;;; Getting help on modules in C-h f ?


@@ -9466,6 +9839,47 @@ We suppose that the regexp is scanned already."
         (setq flist (cdr flist))))
     command))
 
         (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.
 ;;; Initial version contributed by Trey Belew
 (defun cperl-here-doc-spell (&optional beg end)
   "Spell-check HERE-documents in the Perl buffer.


@@ -9786,7 +10200,7 @@ do extra unwind via `cperl-unwind-to-safe'."
          (cperl-fontify-syntaxically to)))))
 
 (defvar cperl-version
          (cperl-fontify-syntaxically to)))))
 
 (defvar cperl-version

-  (let ((v  "$Revision: 5.16 $"))
+  (let ((v  "$Revision: 5.19 $"))

     (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.")
     (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.")