Newer CPerl mode

Some major flaws became appparent in older CPerls, and newer ones
prove themselves reasonably good, so here it is (for inclusion into
5.004):

Description of changes is one page down,

Enjoy,

p5p-msgid: 199705080032.UAA22532@monk.mps.ohio-state.edu

1 files changed, 788 insertions, 149 deletions

diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el
index 6fa07ad29a..017a7a2f61 100644
--- a/emacs/cperl-mode.el
+++ b/emacs/cperl-mode.el
@@ -32,7 +32,7 @@
 ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
 ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
 
-;; $Id: cperl-mode.el,v 1.31+ 1996/12/09 08:03:14 ilya Exp ilya $
+;; $Id: cperl-mode.el,v 1.33 1997/03/14 06:45:51 ilya Exp ilya $
 
 ;;; To use this mode put the following into your .emacs file:
 
@@ -48,7 +48,7 @@
 
 ;;; DO NOT FORGET to read micro-docs. (available from `Perl' menu). <<<<<<
 ;;; or as help on variables `cperl-tips', `cperl-problems',         <<<<<<
-;;; `cperl-non-problems'.                                           <<<<<<
+;;; `cperl-non-problems', `cperl-praise'.                           <<<<<<
 
 ;;; Additional useful commands to put into your .emacs file:
 
@@ -57,7 +57,7 @@
 ;; (setq interpreter-mode-alist (append interpreter-mode-alist
 ;; 				        '(("miniperl" . perl-mode))))
 
-;;; The mode information (on C-h m) provides customization help.
+;;; The mode information (on C-h m) provides some customization help.
 ;;; If you use font-lock feature of this mode, it is advisable to use
 ;;; either lazy-lock-mode or fast-lock-mode (available on ELisp
 ;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock.
@@ -345,7 +345,8 @@
 ;;;; After 1.30
 ;;;  All the keywords from keywords.pl included (maybe with dummy explanation).
 ;;;  No auto-help inside strings, comment, here-docs, formats, and pods.
-;;;  Shrinkwrapping of info, regulated by `cperl-max-help-size'.
+;;;  Shrinkwrapping of info, regulated by `cperl-max-help-size',
+;;;  `cperl-shrink-wrap-info-frame'.
 ;;;  Info on variables as well.
 ;;;  Recognision of HERE-DOCS improved yet more.
 ;;;  Autonewline works on `}' without warnings.
@@ -353,7 +354,65 @@
 
 ;;;; After 1.31
 ;;;  perl-descr.el found its author - hi, Johan!
+;;;  Some support for correct indent after here-docs and friends (may
+;;;  be superseeded by eminent change to Emacs internals).
+;;;  Should work with older Emaxen as well ( `-style stuff removed).
+
+;;;; After 1.32
+
+;;;  Started to add support for `syntax-table' property (should work
+;;;  with patched Emaxen), controlled by
+;;;  `cperl-use-syntax-table-text-property'. Currently recognized:
+;;;    All quote-like operators: m, s, y, tr, qq, qw, qx, q,
+;;;    // in most frequent context: 
+;;;          after block or
+;;;                    ~ { ( = | & + - * ! , ;
+;;;          or 
+;;;                    while if unless until and or not xor split grep map
+;;;    Here-documents, formats, PODs, 
+;;;    ${...}
+;;;    'abc$'
+;;;    sub a ($); sub a ($) {}
+;;;  (provide 'cperl-mode) was missing!
+;;;  `cperl-after-expr-p' is now much smarter after `}'.
+;;;  `cperl-praise' added to mini-docs.
+;;;  Utilities try to support subs-with-prototypes.
+
+;;;; After 1.32.1
+;;;  `cperl-after-expr-p' is now much smarter after "() {}" and "word {}":
+;;;     if word is "else, map, grep".
+;;;  Updated for new values of syntax-table constants.
+;;;  Uses `help-char' (at last!) (disabled, does not work?!)
+;;;  A couple of regexps where missing _ in character classes.
+;;;  -s could be considered as start of regexp, 1../blah/ was not,
+;;;  as was not /blah/ at start of file.
+
+;;;; After 1.32.2
+;;;  "\C-hv" was wrongly "\C-hf"
+;;;  C-hv was not working on `[index()]' because of [] in skip-chars-*.
+;;;  `__PACKAGE__' supported.
+;;;  Thanks for Greg Badros: `cperl-lazy-unstall' is more complete,
+;;;  `cperl-get-help' is made compatible with `query-replace'.
+
+;;;; As of Apr 15, development version of 19.34 supports
+;;;; `syntax-table' text properties. Try setting
+;;;; `cperl-use-syntax-table-text-property'.
+
+;;;; After 1.32.3
+;;;  We scan for s{}[] as well.
+;;;  We scan for $blah'foo as well.
+;;;  The default is to use `syntax-table' text property if Emacs is good enough.
+;;;  `cperl-lineup' is put on C-M-| (=C-M-S-\\).
+;;;  Start of `cperl-beautify-regexp'.
+
+;;;; After 1.32.4
+;;; `cperl-tags-hier-init' did not work in text-mode.
+;;; `cperl-noscan-files-regexp' had a misprint.
+;;; Generation of Class Hierarchy was broken due to a bug in `x-popup-menu'
+;;;  in 19.34.
 
+(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+
 (defvar cperl-extra-newline-before-brace nil
   "*Non-nil means that if, elsif, while, until, else, for, foreach
 and do constructs look like:
@@ -411,7 +470,7 @@ regardless of where in the line point is when the TAB command is used.")
 Can be overwritten by `cperl-hairy' if nil.")
 
 (defvar cperl-electric-lbrace-space nil
-  "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceeded by ` '.
+  "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '.
 Can be overwritten by `cperl-hairy' if nil.")
 
 (defvar cperl-electric-parens-string "({[]})<"
@@ -488,9 +547,24 @@ May require patched `imenu' and `imenu-go'.")
   "*Non-nil means shrink-wrapping of info-buffer-frame allowed.")
 
 (defvar cperl-info-page "perl"
-  "Name of the info page containing perl docs.
+  "*Name of the info page containing perl docs.
 Older version of this page was called `perl5', newer `perl'.")
 
+(defvar cperl-use-syntax-table-text-property 
+  (and (not cperl-xemacs-p)
+       (string< "19.34.94" emacs-version)) ; Not all .94 are good, but anyway
+  "*Non-nil means CPerl sets up and uses `syntax-table' text property.")
+
+(defvar cperl-scan-files-regexp "\\.\\([Pp][Llm]\\|xs\\)$"
+  "*Regexp to match files to scan when generating TAGS.")
+
+(defvar cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$"
+  "*Regexp to match files/dirs to skip when generating TAGS.")
+
+(defvar cperl-regexp-indent-step nil
+  "*indentation used when beautifying regexps.
+If `nil', the value of `cperl-indent-level' will be used.")
+
 
 
 ;;; Short extra-docs.
@@ -546,7 +620,8 @@ indentation, electric keywords, electric braces.
 This may be confusing, since the regexp s#//#/#\; may be highlighted
 as a comment, but it will be recognized as a regexp by the indentation
 code. Or the opposite case, when a pod section is highlighted, but
-breaks the indentation of the following code.
+may break the indentation of the following code (though indentation
+should work if the balance of delimiters is not broken by POD).
 
 The main trick (to make $ a \"backslash\") makes constructions like
 ${aaa} look like unbalanced braces. The only trick I can think of is
@@ -562,15 +637,15 @@ as /($|\\s)/. Note that such a transposition is not always possible
 Most the time, if you write your own code, you may find an equivalent
 \(and almost as readable) expression.
 
-Try to help it: add comments with embedded quotes to fix CPerl
+Try to help CPerl: add comments with embedded quotes to fix CPerl
 misunderstandings about the end of quotation:
 
 $a='500$';      # ';
 
 You won't need it too often. The reason: $ \"quotes\" the following
 character (this saves a life a lot of times in CPerl), thus due to
-Emacs parsing rules it does not consider tick after the dollar as a
-closing one, but as a usual character.
+Emacs parsing rules it does not consider tick (i.e., ' ) after a
+dollar as a closing one, but as a usual character.
 
 Now the indentation code is pretty wise. The only drawback is that it
 relies on Emacs parsing to find matching parentheses. And Emacs
@@ -605,17 +680,78 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
 `car' before `imenu-choose-buffer-index' in `imenu'.
 ")
 
+(defvar cperl-praise 'please-ignore-this-line
+  "RMS asked me to list good things about CPerl. Here they go:
+
+0) It uses the newest `syntax-table' property ;-);
+
+1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl
+mode - but the latter number may have improved too in last years) even 
+without `syntax-table' property; When using this property, it should 
+handle 99.995% of lines correct - or somesuch.
+
+2) It is generally belived to be \"the most user-friendly Emacs
+package\" whatever it may mean (I doubt that the people who say similar
+things tried _all_ the rest of Emacs ;-), but this was not a lonely
+voice);
+
+3) Everything is customizable, one-by-one or in a big sweep;
+
+4) It has many easily-accessable \"tools\":
+        a) Can run program, check syntax, start debugger;
+        b) Can lineup vertically \"middles\" of rows, like `=' in
+                a  = b;
+                cc = d;
+        c) Can insert spaces where this impoves readability (in one
+                interactive sweep over the buffer);
+        d) Has support for imenu, including:
+                1) Separate unordered list of \"interesting places\";
+                2) Separate TOC of POD sections;
+                3) Separate list of packages;
+                4) Hierarchical view of methods in (sub)packages;
+                5) and functions (by the full name - with package);
+        e) Has an interface to INFO docs for Perl; The interface is
+                very flexible, including shrink-wrapping of
+                documentation buffer/frame;
+        f) Has a builtin list of one-line explanations for perl constructs.
+        g) Can show these explanations if you stay long enough at the
+                corresponding place (or on demand);
+        h) Has an enhanced fontification (using 3 or 4 additional faces
+                comparing to font-lock - basically, different
+                namespaces in Perl have different colors);
+        i) Can construct TAGS basing on its knowledge of Perl syntax,
+                the standard menu has 6 different way to generate
+                TAGS (if by directory, .xs files - with C-language
+                bindings - are included in the scan);
+        j) Can build a hierarchical view of classes (via imenu) basing
+                on generated TAGS file;
+        k) Has electric parentheses, electric newlines, uses Abbrev
+                for electric logical constructs
+                        while () {}
+                with different styles of expansion (context sensitive
+                to be not so bothering). Electric parentheses behave
+                \"as they should\" in a presence of a visible region.
+        l) Changes msb.el \"on the fly\" to insert a group \"Perl files\";
+
+5) The indentation engine was very smart, but most of tricks may be
+not needed anymore with the support for `syntax-table' property. Has
+progress indicator for indentation (with `imenu' loaded).
+
+6) Indent-region improves inline-comments as well;
+
+7) Fill-paragraph correctly handles multi-line comments;
+")
+
 
 
 ;;; Portability stuff:
 
-(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
 (defmacro cperl-define-key (fsf-key definition &optional xemacs-key)
-  `(define-key cperl-mode-map
-     ,(if xemacs-key
-	  `(if cperl-xemacs-p ,xemacs-key ,fsf-key)
-	fsf-key)
-     ,definition))
+  (` (define-key cperl-mode-map
+       (, (if xemacs-key
+	      (` (if cperl-xemacs-p (, xemacs-key) (, fsf-key)))
+	    fsf-key))
+       (, definition))))
 
 (defvar del-back-ch (car (append (where-is-internal 'delete-backward-char)
 				 (where-is-internal 'backward-delete-char-untabify)))
@@ -711,15 +847,22 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
   (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
   (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
   (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
+  (cperl-define-key [?\C-\M-\|] 'cperl-lineup)
   ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
   ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
   (cperl-define-key "\177" 'cperl-electric-backspace)
   (cperl-define-key "\t" 'cperl-indent-command)
   ;; don't clobber the backspace binding:
-  (cperl-define-key "\C-hf" 'cperl-info-on-command [(control h) f])
   (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
 		    [(control c) (control h) f])
-  (cperl-define-key "\C-hv" 'cperl-get-help [(control h) v])
+  (cperl-define-key "\C-hf"
+		    ;;(concat (char-to-string help-char) "f") ; does not work
+		    'cperl-info-on-command
+		    [(control h) f])
+  (cperl-define-key "\C-hv"
+		    ;;(concat (char-to-string help-char) "v") ; does not work
+		    'cperl-get-help
+		    [(control h) v])
   (if (and cperl-xemacs-p 
 	   (<= emacs-minor-version 11) (<= emacs-major-version 19))
       (progn
@@ -750,7 +893,10 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
 	   ["Mark function" mark-defun t]
 	   ["Indent expression" cperl-indent-exp t]
 	   ["Fill paragraph/comment" cperl-fill-paragraph t]
+	   "----"
 	   ["Line up a construction" cperl-lineup (cperl-use-region-p)]
+	   ["Beautify a regexp" cperl-beautify-regexp
+	    cperl-use-syntax-table-text-property]
 	   "----"
 	   ["Indent region" cperl-indent-region (cperl-use-region-p)]
 	   ["Comment region" cperl-comment-region (cperl-use-region-p)]
@@ -813,7 +959,8 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
 	   ("Micro-docs"
 	    ["Tips" (describe-variable 'cperl-tips) t]
 	    ["Problems" (describe-variable 'cperl-problems) t]
-	    ["Non-problems" (describe-variable 'cperl-non-problems) t]))))
+	    ["Non-problems" (describe-variable 'cperl-non-problems) t]
+	    ["Praise" (describe-variable 'cperl-praise) t]))))
   (error nil))
 
 (autoload 'c-macro-expand "cmacexp"
@@ -824,6 +971,9 @@ The expansion is entirely correct because it uses the C preprocessor."
 (defvar cperl-mode-syntax-table nil
   "Syntax table in use in Cperl-mode buffers.")
 
+(defvar cperl-string-syntax-table nil
+  "Syntax table in use in Cperl-mode string-like chunks.")
+
 (if cperl-mode-syntax-table
     ()
   (setq cperl-mode-syntax-table (make-syntax-table))
@@ -844,7 +994,11 @@ The expansion is entirely correct because it uses the C preprocessor."
   (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
   (modify-syntax-entry ?_ "w" cperl-mode-syntax-table)
   (modify-syntax-entry ?: "_" cperl-mode-syntax-table)
-  (modify-syntax-entry ?| "." cperl-mode-syntax-table))
+  (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) ; (?# comment )
+)
 
 
 
@@ -941,6 +1095,10 @@ with `cperl-hairy' is 5 secs idle time if the value of this variable
 is nil.  It is also possible to switch this on/off from the
 menu. Requires `run-with-idle-timer'.
 
+Use \\[cperl-lineup] to vertically lineup some construction - put the
+beginning of the region at the start of construction, and make region
+span the needed amount of lines.
+
 Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
 `cperl-pod-face', `cperl-pod-head-face' control processing of pod and
 here-docs sections. In a future version results of scan may be used
@@ -1046,7 +1204,7 @@ with no args."
   (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "#+ *")
   (make-local-variable 'defun-prompt-regexp)
-  (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{;]+\\)[ \t]*")
+  (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)[ \t]*")
   (make-local-variable 'comment-indent-function)
   (setq comment-indent-function 'cperl-comment-indent)
   (make-local-variable 'parse-sexp-ignore-comments)
@@ -1068,6 +1226,10 @@ with no args."
 	  '((perl-font-lock-keywords
 	     perl-font-lock-keywords-1
 	     perl-font-lock-keywords-2))))
+  (if cperl-use-syntax-table-text-property
+      (progn
+	(make-variable-buffer-local 'parse-sexp-lookup-properties)
+	(setq parse-sexp-lookup-properties t)))
   (or (fboundp 'cperl-old-auto-fill-mode)
       (progn
 	(fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
@@ -1270,7 +1432,7 @@ char is \"{\", insert extra newline before only if
 	   (skip-chars-backward "$")
 	   (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
 	 (insert ? ))
-    (if (cperl-after-expr-p nil "{};)") nil (setq cperl-auto-newline nil))
+    (if (cperl-after-expr-p nil "{;)") nil (setq cperl-auto-newline nil))
     (cperl-electric-brace arg)
     (and (cperl-val 'cperl-electric-parens)
 	 (eq last-command-char ?{)
@@ -1299,7 +1461,7 @@ char is \"{\", insert extra newline before only if
 	     (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
 	     ;;(not (save-excursion (search-backward "#" beg t)))
 	     (if (eq last-command-char ?<)
-		 (cperl-after-expr-p nil "{};(,:=")
+		 (cperl-after-expr-p nil "{;(,:=")
 	       1))
 	(progn
 	  (insert last-command-char)
@@ -1350,7 +1512,7 @@ If not, or if we are not at the end of marking range, would self-insert."
 	(dollar (eq last-command-char ?$)))
     (and (save-excursion
 	   (backward-sexp 1)
-	   (cperl-after-expr-p nil "{};:"))
+	   (cperl-after-expr-p nil "{;:"))
 	 (save-excursion 
 	   (not 
 	    (re-search-backward
@@ -1385,7 +1547,7 @@ If not, or if we are not at the end of marking range, would self-insert."
   (let ((beg (save-excursion (beginning-of-line) (point))))
     (and (save-excursion
 	   (backward-sexp 1)
-	   (cperl-after-expr-p nil "{};:"))
+	   (cperl-after-expr-p nil "{;:"))
 	 (save-excursion 
 	   (not 
 	    (re-search-backward
@@ -1616,7 +1778,7 @@ Return the amount the indentation changed by."
     (setq indent (cperl-calculate-indent nil symbol))
     (beginning-of-line)
     (setq beg (point))
-    (cond ((eq indent nil)
+    (cond ((or (eq indent nil) (eq indent t))
 	   (setq indent (current-indentation)))
 	  ;;((eq indent t)    ; Never?
 	  ;; (setq indent (cperl-calculate-indent-within-comment)))
@@ -1625,7 +1787,7 @@ Return the amount the indentation changed by."
 	  (t
 	   (skip-chars-forward " \t")
 	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((looking-at "[A-Za-z]+:[^:]")
+	   (cond ((looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]")
 		  (and (> indent 0)
 		       (setq indent (max cperl-min-label-indent
 					 (+ indent cperl-label-offset)))))
@@ -1705,24 +1867,54 @@ Return the amount the indentation changed by."
 			(progn
 			  (backward-sexp)
 			  (looking-at 
-			   "sub[ \t]+[a-zA-Z0-9_:]+[ \t\n\f]*[#{]")))))))))
+			   "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-start symbol)
   "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."
   (save-excursion
-    (if (memq (get-text-property (point) 'syntax-type) '(pod here-doc)) nil
-      (beginning-of-line)
-      (let* ((indent-point (point))
-	     (case-fold-search nil)
+    (if (or
+	 (memq (get-text-property (point) 'syntax-type) 
+	       '(pod here-doc here-doc-delim format))
+	 ;; before start of POD - whitespace found since do not have 'pod!
+	 (and (looking-at "[ \t]*\n=")
+	      (error "Spaces before pod section!")))
+	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)
+      (cond
+       (in-pod				
+	;; In the verbatim part, probably code example. What to do???
+	)
+       (t 
+	(save-excursion
+	  ;; Not in pod
+	  (cperl-backward-to-noncomment nil)
+	  (setq p (max (point-min) (1- (point)))
+		prop (get-text-property p 'syntax-type)
+		look-prop (or (nth 1 (assoc prop cperl-look-for-prop))
+			      '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)))
+		(beginning-of-line)
+		(setq pre-indent-point (point)))))))
+      (goto-char pre-indent-point)
+      (let* ((case-fold-search nil)
 	     (s-s (cperl-get-state))
 	     (start (nth 0 s-s))
 	     (state (nth 1 s-s))
 	     (containing-sexp (car (cdr state)))
-	     (char-after (save-excursion
-			   (skip-chars-forward " \t")
-			   (following-char)))
 	     (start-indent (save-excursion
 			     (goto-char start)
 			     (- (current-indentation)
@@ -1820,7 +2012,7 @@ Returns nil if line starts inside a string, t if in a comment."
 	      (t
 	       ;; Statement level.  Is it a continuation or a new statement?
 	       ;; Find previous non-comment character.
-	       (goto-char indent-point)
+	       (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.
@@ -1912,7 +2104,7 @@ Returns nil if line starts inside a string, t if in a comment."
 		       (skip-chars-backward " \t")
 		       (if (and (eq (preceding-char) ?b)
 				(progn
-				  (forward-word -1)
+				  (forward-sexp -1)
 				  (looking-at "sub\\>"))
 				(setq old-indent 
 				      (nth 1 
@@ -1926,13 +2118,13 @@ Returns nil if line starts inside a string, t if in a comment."
 			 ;; If line starts with label, calculate label indentation
 			 (if (save-excursion
 			       (beginning-of-line)
-			       (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
+			       (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 
 				(if (and parse-start (<= parse-start (point)))
 				    parse-start)))
-			   (current-indentation)))))))))))))
+			   (current-indentation))))))))))))))
 
 (defvar cperl-indent-alist
   '((string nil)
@@ -2086,7 +2278,7 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
 		     ;; If line starts with label, calculate label indentation
 		     (if (save-excursion
 			   (beginning-of-line)
-			   (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
+			   (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 
@@ -2116,7 +2308,9 @@ the current line is to be regarded as part of a block comment."
 Returns true if comment is found."
   (let (state stop-in cpoint (lim (progn (end-of-line) (point))))
       (beginning-of-line)
-      (if (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t) 
+      (if (or 
+	   (eq (get-text-property (point) 'syntax-type) 'pod)
+	   (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t))
 	  (if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
 	;; Else
 	(while (not stop-in)
@@ -2158,6 +2352,38 @@ Returns true if comment is found."
 	  )
 	(nth 4 state))))
 
+(defsubst cperl-1- (p)
+  (max (point-min) (1- p)))
+
+(defsubst cperl-1+ (p)
+  (min (point-max) (1+ p)))
+
+(defvar cperl-st-cfence '(14))		; Comment-fence
+(defvar cperl-st-sfence '(15))		; String-fence
+(defvar cperl-st-punct '(1))
+(defvar cperl-st-word '(2))
+
+(defun cperl-protect-defun-start (s e)
+  ;; C code looks for "^\\s(" to skip comment backward in "hard" situations
+  (save-excursion
+    (goto-char s)
+    (while (re-search-forward "^\\s(" e 'to-end)
+      (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct))))
+
+(defun cperl-commentify (bb e string)
+  (if cperl-use-syntax-table-text-property 
+      (progn
+	;; We suppose that e is _after_ the end of construction, as after eol.
+	(setq string (if string cperl-st-sfence cperl-st-cfence))
+	(put-text-property bb (1+ bb) 'syntax-table string)
+	(put-text-property bb (1+ bb) 'rear-nonsticky t)
+	(put-text-property (1- e) e 'syntax-table string)
+	(put-text-property (1- e) e 'rear-nonsticky t)
+	(if (and (eq string cperl-st-sfence) (> (- e 2) bb))
+	    (put-text-property (1+ bb) (1- e) 
+			       'syntax-table cperl-string-syntax-table))
+	(cperl-protect-defun-start bb e))))
+
 (defun cperl-find-pods-heres (&optional min max)
   "Scans the buffer for POD sections and here-documents.
 If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify 
@@ -2166,11 +2392,12 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
   (interactive)
   (or min (setq min (point-min)))
   (or max (setq max (point-max)))
-  (let (face head-face here-face b e bb tag qtag err b1 e1 argument
+  (let (face head-face here-face b e bb tag qtag err b1 e1 argument st i c
 	     (cperl-pod-here-fontify (eval cperl-pod-here-fontify))
 	     (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
 	     (modified (buffer-modified-p))
 	     (after-change-functions nil)
+	     (state-point (point-min)) state
 	     (search
 	      (concat
 	       "\\(\\`\n?\\|\n\n\\)=" 
@@ -2190,7 +2417,25 @@ 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]*$"
+	       (if cperl-use-syntax-table-text-property
+		   (concat
+		    "\\|"
+		    ;; 1+6+2=9 extra () before this:
+		    "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>"
+		    "\\|"
+		    ;; 1+6+2+1=10 extra () before this:
+		    "\\([?/]\\)"	; /blah/ or ?blah?
+		    "\\|"
+		    ;; 1+6+2+1+1=11 extra () before this:
+		    "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"
+		    "\\|"
+		    ;; 1+6+2+1+1+2=13 extra () before this:
+		    "\\$\\(['{]\\)"
+		    "\\|"
+		    ;; 1+6+2+1+1+2+1=14 extra () before this:
+		    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
+		 ""))))
     (unwind-protect
 	(progn
 	  (save-excursion
@@ -2200,7 +2445,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		(setq face cperl-pod-face
 		      head-face cperl-pod-head-face
 		      here-face cperl-here-face))
-	    (remove-text-properties min max '(syntax-type t))
+	    (remove-text-properties min max 
+				    '(syntax-type t in-pod t syntax-table t))
 	    ;; Need to remove face as well...
 	    (goto-char min)
 	    (while (re-search-forward search max t)
@@ -2209,20 +2455,23 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		;;  "\\(\\`\n?\\|\n\n\\)=" 
 		(if (looking-at "\n*cut\\>")
 		    (progn
-		      (message "=cut is not preceeded by a pod section")
-		      (setq err (point)))
+		      (message "=cut is not preceded by a pod section")
+		      (or err (setq err (point))))
 		  (beginning-of-line)
 		
 		  (setq b (point) bb b)
 		  (or (re-search-forward "\n\n=cut\\>" max 'toend)
-		      (message "Cannot find the end of a pod section"))
-		  (beginning-of-line 3)
+		      (progn
+			(message "Cannot find the end of a pod section")
+			(or err (setq err b))))
+		  (beginning-of-line 2)	; An empty line after =cut is not POD!
 		  (setq e (point))
 		  (put-text-property b e 'in-pod t)
 		  (goto-char b)
 		  (while (re-search-forward "\n\n[ \t]" e t)
+		    ;; We start 'pod 1 char earlier to include the preceding line
 		    (beginning-of-line)
-		    (put-text-property b (point) 'syntax-type 'pod)
+		    (put-text-property (cperl-1- b) (point) 'syntax-type 'pod)
 		    (cperl-put-do-not-fontify b (point))
 		    ;;(put-text-property (max (point-min) (1- b))
 		    ;;		     (point) cperl-do-not-fontify t)
@@ -2230,7 +2479,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		    (re-search-forward "\n\n[^ \t\f\n]" e 'toend)
 		    (beginning-of-line)
 		    (setq b (point)))
-		  (put-text-property (point) e 'syntax-type 'pod)
+		  (put-text-property (cperl-1- (point)) e 'syntax-type 'pod)
 		  (cperl-put-do-not-fontify (point) e)
 		  ;;(put-text-property (max (point-min) (1- (point)))
 		  ;;		   e cperl-do-not-fontify t)
@@ -2238,28 +2487,33 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      (progn (put-text-property (point) e 'face face)
 			     (goto-char bb)
 			     (if (looking-at 
-				  "=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
+				  "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
 				 (put-text-property 
 				  (match-beginning 1) (match-end 1)
 				  'face head-face))
 			     (while (re-search-forward
 				     ;; One paragraph
-				     "\n\n=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
+				     "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
 				     e 'toend)
 			       (put-text-property 
 				(match-beginning 1) (match-end 1)
 				'face head-face))))
+		  (cperl-commentify bb e nil)
 		  (goto-char e)))
 	       ;; Here document
+	       ;; We do only one here-per-line
 	       ;; 1 () ahead
 	       ;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
 	       ((match-beginning 2)	; 1 + 1
-		;; Abort in comment (_extremely_ simplified):
+		;; Abort in comment:
 		(setq b (point))
-		(if (save-excursion
-		      (beginning-of-line)
-		      (search-forward "#" b t))
-		    nil
+		(setq state (parse-partial-sexp state-point b nil nil state)
+		      state-point b)
+		(if ;;(save-excursion
+		    ;;  (beginning-of-line)
+		    ;;  (search-forward "#" b t))
+		    (or (nth 3 state) (nth 4 state))
+		    (goto-char (match-end 2))
 		  (if (match-beginning 5) ;4 + 1
 		      (setq b1 (match-beginning 5) ; 4 + 1
 			    e1 (match-end 5)) ; 4 + 1
@@ -2284,14 +2538,21 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			       ;;		      cperl-do-not-fontify t)
 			       (put-text-property b (match-beginning 0) 
 						  'face here-face)))
+			 (setq e1 (cperl-1+ (match-end 0)))
 			 (put-text-property b (match-beginning 0) 
 					    'syntax-type 'here-doc)
-			 (cperl-put-do-not-fontify b (match-beginning 0)))
-			(t (message "End of here-document `%s' not found." tag)))))
+			 (put-text-property (match-beginning 0) e1
+					    'syntax-type 'here-doc-delim)
+			 (put-text-property b e1
+					    'here-doc-group t)
+			 (cperl-commentify b e1 nil)
+			 (cperl-put-do-not-fontify b (match-end 0)))
+			(t (message "End of here-document `%s' not found." tag)
+			   (or err (setq err b))))))
 	       ;; format
-	       (t
+	       ((match-beginning 8)
 		;; 1+6=7 extra () before this:
-		;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
+		;;"^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
 		(setq b (point)
 		      name (if (match-beginning 8) ; 7 + 1
 			       (buffer-substring (match-beginning 8) ; 7 + 1
@@ -2315,6 +2576,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			(end-of-line)
 			(put-text-property b1 (point) 
 					   'face font-lock-string-face)
+			(cperl-commentify b1 (point) nil)
 			(cperl-put-do-not-fontify b1 (point)))))
 		  (re-search-forward (concat "^[.;]$") max 'toend))
 		(beginning-of-line)
@@ -2322,8 +2584,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		    (progn
 		      (put-text-property (point) (+ (point) 2)
 					 'face font-lock-string-face)
+		      (cperl-commentify (point) (+ (point) 2) nil)
 		      (cperl-put-do-not-fontify (point) (+ (point) 2)))
-		  (message "End of format `%s' not found." name))
+		  (message "End of format `%s' not found." name)
+		  (or err (setq err b)))
 		(forward-line)
 		(put-text-property b (point) 'syntax-type 'format)
 ;;;	       (cond ((re-search-forward (concat "^[.;]$") max 'toend)
@@ -2336,11 +2600,165 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 ;;;					 'syntax-type 'format)
 ;;;		      (cperl-put-do-not-fontify b (match-beginning 0)))
 ;;;		     (t (message "End of format `%s' not found." name)))
-		)))
+		)
+	       ;; Regexp:
+	       ((or (match-beginning 10) (match-beginning 11))
+		;; 1+6+2=9 extra () before this:
+		;; "\\<\\(qx?\\|[my]\\)\\>"
+		(setq b1 (if (match-beginning 10) 10 11)
+		      argument (buffer-substring
+				(match-beginning b1) (match-end b1))
+		      b (point)
+		      i b
+		      c (char-after (match-beginning b1))
+		      bb (or
+			  (memq (char-after (1- (match-beginning b1)))
+				'(?\$ ?\@ ?\% ?\& ?\*))
+			  (and
+			   (eq (char-after (1- (match-beginning b1))) ?-)
+			   (eq (char-after (match-beginning b1)) ?s))))
+		(or bb
+		    (if (eq b1 11)	; bare /blah/ or ?blah?
+			(setq argument ""
+			     bb 
+			     (progn
+			       (goto-char (match-beginning b1))
+			       (cperl-backward-to-noncomment (point-min))
+			       (not (or (memq (preceding-char)
+					      (append (if (eq 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)
+					       (looking-at 
+						"\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\)\\>")))
+					(and (eq (preceding-char) ?.)
+					     (eq (char-after (- (point) 2)) ?.))
+					(bobp))))
+			     b (1- b))))
+		(or bb (setq state (parse-partial-sexp 
+				    state-point b nil nil state)
+			     state-point b))
+		(goto-char b)
+		(if (or bb (nth 3 state) (nth 4 state))
+		    (goto-char i)
+		  (skip-chars-forward " \t")
+		  ;; qtag means two-argument matcher, may be reset to
+		  ;; 2 or 3 later if some special quoting is needed.
+		  (setq b (point) 
+			tag (char-after b)
+			qtag (if (string-match "^\\([sy]\\|tr\\)$" argument) t)
+			e1 (cdr (assoc tag '(( ?\( . ?\) )
+					     ( ?\[ . ?\] )
+					     ( ?\{ . ?\} )
+					     ( ?\< . ?\> )
+					     ))))
+		  ;; What if tag == ?\\  ????
+		  (or st 
+		      (progn
+			(setq st (make-syntax-table) i 0)
+			(while (< i 256)
+			  (modify-syntax-entry i "." st)
+			  (setq i (1+ i)))
+			(modify-syntax-entry ?\\ "\\" st)))
+		  ;; Whether we have an intermediate point
+		  (setq i nil)
+		  ;; Prepare the syntax table:
+		  (cond
+		   ;; $ has TeXish matching rules, so $$ equiv $...
+		   ((and qtag 
+			 (not e1) 
+			 (eq tag (char-after (cperl-1+ b)))
+			 (eq tag (char-after (+ 2 b))))
+		    (setq qtag 3))	; s///
+		   ((and qtag
+			 (not e1) 
+			 (eq tag (char-after (cperl-1+ b))))
+		    (setq qtag nil))	; s//blah/, will work anyway
+		   ((and (not e1) 
+			 (eq tag (char-after (cperl-1+ b))))
+		    (setq qtag 2))	; m//
+		   ((not e1)
+		    (modify-syntax-entry tag "$" st)) ; m/blah/, s/x//, s/x/y/
+		   (t			; s{}(), m[]
+		    (modify-syntax-entry tag (concat "(" (list e1)) st)
+		    (modify-syntax-entry e1  (concat ")" (list tag)) st)))
+		  (if (numberp qtag)
+		      (forward-char qtag)
+		    (condition-case bb
+			(progn
+			  (set-syntax-table st)
+			  (forward-sexp 1) ; Wrong if m// - taken care of...
+			  (if qtag
+			      (if e1 
+				  (progn
+				    (setq i (point))
+				    (set-syntax-table cperl-mode-syntax-table)
+				    (forward-sexp 1)) ; Should be smarter?
+				;; "$" has funny matching rules
+				(if (/= (char-after (- (point) 2)) 
+					(preceding-char))
+				    (progn
+				      ;; Commenting \\ is dangerous, what about ( ?
+				      (if (eq (following-char) ?\\) nil
+					(setq i (point)))
+				      (forward-char -1)
+				      (forward-sexp 1)))
+				)))
+		      (error (goto-char (point-max))
+			     (message
+			      "End of `%s%c ... %c' string not found: %s"
+			      argument tag (or e1 tag) bb)
+			     (or err (setq err b)))))
+		  (set-syntax-table cperl-mode-syntax-table)
+		  (if (null i)
+		      (cperl-commentify b (point) t)
+		    (cperl-commentify b i t)
+		    (if (looking-at "\\sw*e") nil ; s///e
+		      (cperl-commentify i (point) t)))
+		  (if (eq (char-syntax (following-char)) ?w)
+		      (forward-word 1))	; skip modifiers s///s
+		  (modify-syntax-entry tag "." st)
+		  (if e1 (modify-syntax-entry e1 "." st))))
+	       ((match-beginning 13)	; sub with prototypes
+		(setq b (match-beginning 0))
+		(if (memq (char-after (1- b))
+			  '(?\$ ?\@ ?\% ?\& ?\*))
+		    nil
+		  (setq state (parse-partial-sexp 
+			       state-point (1- b) nil nil state)
+			state-point (1- 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))))
+	       ((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
+		    (progn
+		      (put-text-property (1- b) b 'syntax-table cperl-st-punct)
+		      (put-text-property (1- b) b 'rear-nonsticky t)))
+		(goto-char (1+ b)))
+	       ((match-beginning 14)	; ${
+		(setq bb (match-beginning 0))
+		(put-text-property bb (1+ bb) 'syntax-table cperl-st-punct)
+		(put-text-property bb (1+ bb) 'rear-nonsticky t))
+	       (t			; old $abc'efg syntax
+		(setq bb (match-end 0))
+		(put-text-property (1- bb) bb 'syntax-table cperl-st-word))))
 ;;;	    (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
 ;;;	      (if (looking-at "\n*cut\\>")
 ;;;		  (progn
-;;;		    (message "=cut is not preceeded by a pod section")
+;;;		    (message "=cut is not preceded by a pod section")
 ;;;		    (setq err (point)))
 ;;;		(beginning-of-line)
 		
@@ -2436,7 +2854,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 	    (message "Scan for pods, formats and here-docs completed.")))
       (and (buffer-modified-p)
 	   (not modified)
-	   (set-buffer-modified-p nil)))))
+	   (set-buffer-modified-p nil))
+      (set-syntax-table cperl-mode-syntax-table))))
 
 (defun cperl-backward-to-noncomment (lim)
   ;; Stops at lim or after non-whitespace that is not in comment
@@ -2452,13 +2871,30 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 	(if (< p (point)) (goto-char p))
 	(setq stop t)))))
 
+(defun cperl-after-block-p (lim)
+  ;; We suppose that the preceding char is }.
+  (save-excursion
+    (condition-case nil
+	(progn
+	  (forward-sexp -1)
+	  (cperl-backward-to-noncomment lim)
+	  (or (eq (preceding-char) ?\) ) ; if () {}
+	      (and (eq (char-syntax (preceding-char)) ?w) ; else {}
+		   (progn
+		     (forward-sexp -1)
+		     (looking-at "\\(else\\|grep\\|map\\)\\>")))
+	      (cperl-after-expr-p lim)))
+      (error nil))))
+
 (defun cperl-after-expr-p (&optional lim chars test)
   "Returns true if the position is good for start of expression.
 TEST is the expression to evaluate at the found position. If absent,
-CHARS is a string that contains good characters to have before us."
-  (let (stop p)
+CHARS is a string that contains good characters to have before us (however,
+`}' is treated \"smartly\" if it is not in the list)."
+  (let (stop p 
+	     (lim (or lim (point-min))))
     (save-excursion
-      (while (and (not stop) (> (point) (or lim 1)))
+      (while (and (not stop) (> (point) lim))
 	(skip-chars-backward " \t\n\f" lim)
 	(setq p (point))
 	(beginning-of-line)
@@ -2470,9 +2906,10 @@ CHARS is a string that contains good characters to have before us."
 	  (setq stop t)))
       (or (bobp)
 	  (progn
-	    (backward-char 1)
 	    (if test (eval test)
-	      (memq (following-char) (append (or chars "{};") nil))))))))
+	      (or (memq (preceding-char) (append (or chars "{;") nil))
+		  (and (eq (preceding-char) ?\})
+		       (cperl-after-block-p lim)))))))))
 
 (defun cperl-backward-to-start-of-continued-exp (lim)
   (if (memq (preceding-char) (append ")]}\"'`" nil))
@@ -2540,7 +2977,8 @@ inclusive."
 						   comment-column))
 		     (setq old-comm-indent nil)))
 	    (if (and old-comm-indent
-		     (= (current-indentation) old-comm-indent))
+		     (= (current-indentation) old-comm-indent)
+		     (not (eq (get-text-property (point) 'syntax-type) 'pod)))
 		(let ((comment-column new-comm-indent))
 		  (indent-for-comment)))
 	  (progn 
@@ -2548,6 +2986,7 @@ inclusive."
 	    (or comm
 		(progn
 		  (if (setq old-comm-indent (and (cperl-to-comment-or-eol)
+						 (not (eq (get-text-property (point) 'syntax-type) 'pod))
 						 (current-column)))
 		      (progn (indent-for-comment)
 			     (skip-chars-backward " \t")
@@ -2558,16 +2997,16 @@ inclusive."
 	     (imenu-progress-message pm 100)
 	  (message nil)))))
 
-(defun cperl-slash-is-regexp (&optional pos)
-  (save-excursion
-    (goto-char (if pos pos (1- (point))))
-    (and
-     (not (memq (get-text-property (point) 'face)
-		'(font-lock-string-face font-lock-comment-face)))
-     (cperl-after-expr-p nil nil '
-		       (or (looking-at "[^]a-zA-Z0-9_)}]")
-			   (eq (get-text-property (point) 'face)
-			       'font-lock-keyword-face))))))
+;;(defun cperl-slash-is-regexp (&optional pos)
+;;  (save-excursion
+;;    (goto-char (if pos pos (1- (point))))
+;;    (and
+;;     (not (memq (get-text-property (point) 'face)
+;;		'(font-lock-string-face font-lock-comment-face)))
+;;     (cperl-after-expr-p nil nil '
+;;		       (or (looking-at "[^]a-zA-Z0-9_)}]")
+;;			   (eq (get-text-property (point) 'face)
+;;			       'font-lock-keyword-face))))))
 
 ;; Stolen from lisp-mode with a lot of improvements
 
@@ -2679,7 +3118,12 @@ indentation and initial hashes. Behaves usually outside of comment."
       (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
 
 (defvar imenu-example--function-name-regexp-perl
-      "^\\([ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\|=head\\([12]\\)[ \t]+\\([^\n]+\\)$\\)")
+  (concat 
+   "^\\("
+       "[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?"
+     "\\|"
+       "=head\\([12]\\)[ \t]+\\([^\n]+\\)$"
+   "\\)"))
 
 (defun cperl-imenu-addback (lst &optional isback name)
   ;; We suppose that the lst is a DAG, unless the first element only
@@ -2718,13 +3162,21 @@ indentation and initial hashes. Behaves usually outside of comment."
 	(imenu-progress-message prev-pos)
 	;;(backward-up-list 1)
 	(cond
-	 ((match-beginning 2)		; package or sub
+	 ((and
+	   (match-beginning 2)		; package or sub
+	   ;; Skip if quoted (will not skip multi-line ''-comments :-():
+	   (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 char (following-char) meth nil)
-	  (setq p (point))
+	  ;; (if (looking-at "([^()]*)[ \t\n\f]*")
+	  ;;    (goto-char (match-end 0)))	; Messes what follows
+	  (setq char (following-char) 
+		meth nil
+		p (point))
 	  (while (and ends-ranges (>= p (car ends-ranges)))
 	    ;; delete obsolete entries
 	    (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
@@ -2760,12 +3212,12 @@ indentation and initial hashes. Behaves usually outside of comment."
 	      (push index index-alist))
 	    (if meth (push index index-meth-alist))
 	    (push index index-unsorted-alist)))
-	 (t				; Pod section
+	 ((match-beginning 5)		; Pod section
 	  ;; (beginning-of-line)
 	  (setq index (imenu-example--name-and-position)
-		name (buffer-substring (match-beginning 5) (match-end 5)))
+		name (buffer-substring (match-beginning 6) (match-end 6)))
 	  (set-text-properties 0 (length name) nil name)
-	  (if (eq (char-after (match-beginning 4)) ?2)
+	  (if (eq (char-after (match-beginning 5)) ?2)
 	      (setq name (concat "   " name)))
 	  (setcar index name)
 	  (setq index1 (cons (concat "=" name) (cdr index)))
@@ -2954,7 +3406,7 @@ indentation and initial hashes. Behaves usually outside of comment."
 	      "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
 	      "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
 	      "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
-	      "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\)"
+	      "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\|PACKAGE__\\)"
 	      "\\)\\>") 2 'font-lock-type-face)
 	    ;; In what follows we use `other' style
 	    ;; for nonoverwritable builtins
@@ -2988,7 +3440,7 @@ indentation and initial hashes. Behaves usually outside of comment."
 	    ;;			   "\\|")
 	    '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
 	      font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
-	    '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*[{\n]" 1
+	    '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1
 	      font-lock-function-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)
@@ -3477,7 +3929,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame',
 (defun cperl-imenu-info-imenu-search ()
   (if (looking-at "^-X[ \t\n]") nil
     (re-search-backward
-     "^\n\\([-a-zA-Z]+\\)[ \t\n]")
+     "^\n\\([-a-zA-Z_]+\\)[ \t\n]")
     (forward-line 1)))
 
 (defun cperl-imenu-info-imenu-name ()  
@@ -3577,7 +4029,7 @@ 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]*\\([{#]\\|$\\)\\)/\\4/"))
+	(args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([{#]\\|$\\)\\)/\\4/"))
 	res)
     (if add (setq args (cons "-a" args)))
     (or files (setq files (list buffer-file-name)))
@@ -3766,12 +4218,15 @@ in subdirectories too."
 	       (erase-buffer)
 	       (setq erase 'ignore)))
 	(let ((files 
-	       (directory-files file t (if recurse nil "\\.[Pp][Llm]$") t)))
+	       (directory-files file t 
+				(if recurse nil cperl-scan-files-regexp)
+				t)))
 	  (mapcar (function (lambda (file)
 			      (cond
-			       ((string-match "/\\.\\.?$" file) nil)
+			       ((string-match cperl-noscan-files-regexp file)
+				nil)
 			       ((not (file-directory-p file))
-				(if (string-match "\\.\\([Pp][Llm]\\|xs\\)$" file)
+				(if (string-match cperl-scan-files-regexp file)
 				    (cperl-write-tags file erase recurse nil t)))
 			       ((not recurse) nil)
 			       (t (cperl-write-tags file erase recurse t t)))))
@@ -3799,7 +4254,16 @@ in subdirectories too."
 	    (initialize-new-tags-table))))))
 
 (defvar cperl-tags-hier-regexp-list
-  "^\\(\\(package\\)\\>\\|sub\\>[^\n]+::\\|[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::\\|[ \t]*BOOT:\C-?[^\n]+::\\)")
+  (concat 
+   "^\\("
+      "\\(package\\)\\>"
+     "\\|"
+      "sub\\>[^\n]+::"
+     "\\|"
+      "[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::" ; XSUB?
+     "\\|"
+      "[ \t]*BOOT:\C-?[^\n]+::"		; BOOT section
+   "\\)"))
 
 (defvar cperl-hierarchy '(() ())
   "Global hierarchy of classes")
@@ -3812,7 +4276,14 @@ in subdirectories too."
       (setq pos (match-beginning 0) 
 	    pack (match-beginning 2))
       (beginning-of-line)
-      (if (looking-at "\\([^\n]+\\)\C-?\\([^\n]+\\)\C-a\\([0-9]+\\),\\([0-9]+\\)")
+      (if (looking-at (concat
+		       "\\([^\n]+\\)"
+		       "\C-?"
+		       "\\([^\n]+\\)"
+		       "\C-a"
+		       "\\([0-9]+\\)"
+		       ","
+		       "\\([0-9]+\\)"))
 	  (progn
 	    (setq ;;str (buffer-substring (match-beginning 1) (match-end 1))
 		  name (buffer-substring (match-beginning 2) (match-end 2))
@@ -3880,7 +4351,7 @@ One may build such TAGS files from CPerl mode menu."
 	(if window-system
 	    (x-popup-menu t (nth 2 cperl-hierarchy))
 	  (require 'tmm)
-	  (tmm-prompt t (nth 2 cperl-hierarchy))))
+	  (tmm-prompt (nth 2 cperl-hierarchy))))
   (if (and update (listp update))
       (progn (while (cdr update) (setq update (cdr update)))
 	     (setq update (car update)))) ; Get the last from the list
@@ -3990,7 +4461,7 @@ One may build such TAGS files from CPerl mode menu."
 			   (cons (car elt)
 				 (cperl-menu-to-keymap list))))
 		    (t
-		     (list (cdr elt) (car elt))))))
+		     (list (cdr elt) (car elt) t))))) ; t is needed in 19.34
 	   (cperl-list-fold menu "Root" imenu-max-items)))))
 
 
@@ -4005,8 +4476,8 @@ One may build such TAGS files from CPerl mode menu."
 (defvar cperl-not-bad-style-regexp 
   (mapconcat 'identity
    '("[^-\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)
+     "[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>
      "-[a-zA-Z][ \t]+[_$\"'`]"		; -f file
      "-[0-9]"				; -5
@@ -4019,7 +4490,7 @@ One may build such TAGS files from CPerl mode menu."
      "||"
      "&&"
      "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>
-     "-[a-zA-Z0-9]+[ \t]*=>"			; -option => value
+     "-[a-zA-Z_0-9]+[ \t]*=>"			; -option => value
      ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below
      ;;"[*/+-|&<.]+="
      )
@@ -4126,7 +4597,7 @@ Currently it is tuned to C and Perl syntax."
   ;; Try to backtrace
   (cond
    ((looking-at "[a-zA-Z0-9_:]")	; symbol
-    (skip-chars-backward "[a-zA-Z0-9_:]")
+    (skip-chars-backward "a-zA-Z0-9_:")
     (cond 
      ((and (eq (preceding-char) ?^)	; $^I
 	   (eq (char-after (- (point) 2)) ?\$))
@@ -4144,7 +4615,7 @@ Currently it is tuned to C and Perl syntax."
    ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I
     (forward-char -1))
    ((looking-at "[-!&*+,-./<=>?\\\\^|~]")
-    (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]")
+    (skip-chars-backward "-!&*+,-./<=>?\\\\^|~")
     (cond
      ((and (eq (preceding-char) ?\$)
 	   (not (eq (char-after (- (point) 2)) ?\$))) ; $-
@@ -4168,20 +4639,21 @@ Currently it is tuned to C and Perl syntax."
 The data for these docs is a little bit obsolete and may be in fact longer
 than a line. Your contribution to update/shorten it is appreciated."
   (interactive)
-  (save-excursion
-    (let ((word (cperl-word-at-point-hard)))
-      (if word
-	  (if (and cperl-help-from-timer ; Bail out if not in mainland
-		   (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings.
-		   (or (memq (get-text-property (point) 'face)
-			     '(font-lock-comment-face font-lock-string-face))
-		       (memq (get-text-property (point) 'syntax-type)
-			     '(pod here-doc format))))
-	      nil
-	    (cperl-describe-perl-symbol word))
-	(if cperl-message-on-help-error
-	    (message "Nothing found for %s..." 
-		     (buffer-substring (point) (+ 5 (point)))))))))
+  (save-match-data			; May be called "inside" query-replace
+    (save-excursion
+      (let ((word (cperl-word-at-point-hard)))
+	(if word
+	    (if (and cperl-help-from-timer ; Bail out if not in mainland
+		     (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings.
+		     (or (memq (get-text-property (point) 'face)
+			       '(font-lock-comment-face font-lock-string-face))
+			 (memq (get-text-property (point) 'syntax-type)
+			       '(pod here-doc format))))
+		nil
+	      (cperl-describe-perl-symbol word))
+	  (if cperl-message-on-help-error
+	      (message "Nothing found for %s..." 
+		       (buffer-substring (point) (min (+ 5 (point)) (point-max))))))))))
 
 ;;; Stolen from perl-descr.el by Johan Vromans:
 
@@ -4365,7 +4837,7 @@ $~	The name of the current report format.
 @ARGV	Command line arguments (not including the command name - see $0).
 @INC	List of places to look for perl scripts during do/include/use.
 @_	Parameter array for subroutines. Also used by split unless in array context.
-\\	Creates a reference to whatever follows, like \$var.
+\\  Creates reference to what follows, like \$var, or quotes non-\w in strings.
 \\0	Octal char, e.g. \\033.
 \\E	Case modification terminator. See \\Q, \\L, and \\U.
 \\L	Lowercase until \\E . See also \l, lc.
@@ -4376,17 +4848,18 @@ $~	The name of the current report format.
 \\c	Control character, e.g. \\c[ .
 \\e	Escape character (octal 033).
 \\f	Formfeed character (octal 014).
-\\l	Lowercase the next character. See also \\L and \\u, lcfirst,
-\\n	Newline character (octal 012).
-\\r	Return character (octal 015).
+\\l	Lowercase the next character. See also \\L and \\u, lcfirst.
+\\n	Newline character (octal 012 on most systems).
+\\r	Return character (octal 015 on most systems).
 \\t	Tab character (octal 011).
-\\u	Upcase the next character. See also \\U and \\l, ucfirst,
+\\u	Upcase the next character. See also \\U and \\l, ucfirst.
 \\x	Hex character, e.g. \\x1b.
-^ ...	Bitwise exclusive or.
+... ^ ...	Bitwise exclusive or.
 __END__	Ends program source.
 __DATA__	Ends program source.
 __FILE__	Current (source) filename.
 __LINE__	Current line in current source.
+__PACKAGE__	Current package.
 ARGV	Default multi-file input filehandle. <ARGV> is a synonym for <>.
 ARGVOUT	Output filehandle with -i flag.
 BEGIN { ... }	Immediately executed (during compilation) piece of code.
@@ -4416,7 +4889,7 @@ defined(EXPR)
 delete($HASH{KEY})
 die(LIST)
 do { ... }|SUBR while|until EXPR	executes at least once
-do(EXPR|SUBR([LIST]))
+do(EXPR|SUBR([LIST]))	(with while|until executes at least once)
 dump LABEL
 each(%HASH)
 endgrent
@@ -4498,10 +4971,10 @@ next [LABEL]
 oct(EXPR)
 open(FILEHANDLE[,EXPR])
 opendir(DIRHANDLE,EXPR)
-ord(EXPR)
+ord(EXPR)	ASCII value of the first char of the string.
 pack(TEMPLATE,LIST)
 package NAME	Introduces package context.
-pipe(READHANDLE,WRITEHANDLE)
+pipe(READHANDLE,WRITEHANDLE)	Create a pair of filehandles on ends of a pipe.
 pop(ARRAY)
 print [FILEHANDLE] [(LIST)]
 printf [FILEHANDLE] (FORMAT,LIST)
@@ -4584,7 +5057,7 @@ values(%HASH)
 vec(EXPR,OFFSET,BITS)
 wait
 waitpid(PID,FLAGS)
-wantarray
+wantarray	Returns true if the sub/eval is called in list context.
 warn(LIST)
 while  (EXPR) { ... }					EXPR while EXPR
 write[(EXPR|FILEHANDLE)]
@@ -4608,32 +5081,32 @@ DESTROY		Shorthand for `sub DESTROY {...}'.
 abs [ EXPR ]	absolute value
 ... and ...		Low-precedence synonym for &&.
 bless REFERENCE [, PACKAGE]	Makes reference into an object of a package.
-chomp		Docs missing
-chr		Docs missing
+chomp [LIST]	Strips $/ off LIST/$_. Returns count. Special if $/ eq ''!
+chr		Converts a number to char with the same ordinal.
 else		Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
 elsif		Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
 exists	$HASH{KEY}	True if the key exists.
-format		Docs missing
-formline	Docs missing
+format [NAME] =	 Start of output format. Ended by a single dot (.) on a line.
+formline PICTURE, LIST	Backdoor into \"format\" processing.
 glob EXPR	Synonym of <EXPR>.
 lc [ EXPR ]	Returns lowercased EXPR.
 lcfirst [ EXPR ]	Returns EXPR with lower-cased first letter.
-map		Docs missing
+map EXPR, LIST	or map {BLOCK} LIST	Applies EXPR/BLOCK to elts of LIST.
 no PACKAGE [SYMBOL1, ...]  Partial reverse for `use'. Runs `unimport' method.
-... not ...		Low-precedence synonym for ! - negation.
+not ...		Low-precedence synonym for ! - negation.
 ... or ...		Low-precedence synonym for ||.
 pos STRING    Set/Get end-position of the last match over this string, see \\G.
-quotemeta [ EXPR ]	Quote metacharacters.
-qw		Docs missing
+quotemeta [ EXPR ]	Quote regexp metacharacters.
+qw/WORD1 .../		Synonym of split('', 'WORD1 ...')
 readline FH	Synonym of <FH>.
 readpipe CMD	Synonym of `CMD`.
 ref [ EXPR ]	Type of EXPR when dereferenced.
-sysopen		Docs missing
-tie		Docs missing
-tied		Docs missing
+sysopen FH, FILENAME, MODE [, PERM]	(MODE is numeric, see Fcntl.)
+tie VAR, PACKAGE, LIST	Hide an object behind a simple Perl variable.
+tied		Returns internal object for a tied data.
 uc [ EXPR ]	Returns upcased EXPR.
 ucfirst [ EXPR ]	Returns EXPR with upcased first letter.
-untie		Docs missing
+untie VAR	Unlink an object from a simple Perl variable.
 use PACKAGE [SYMBOL1, ...]  Compile-time `require' with consequent `import'.
 ... xor ...		Low-precedence synonym for exclusive or.
 prototype \&SUB	Returns prototype of the function given a reference.
@@ -4660,30 +5133,194 @@ prototype \&SUB	Returns prototype of the function given a reference.
 					  'variable-documentation))
 	  (setq buffer-read-only t)))))
 
+(defun cperl-beautify-regexp-piece (b e embed)
+  ;; b is before the starting delimiter, e before the ending
+  ;; e should be a marker, may be changed, but remains "correct".
+  (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline)
+    (if (not embed)
+	(goto-char (1+ b))
+      (goto-char b)
+      (cond ((looking-at "(\\?\\\\#")	; badly commented (?#)
+	     (forward-char 2)
+	     (delete-char 1)
+	     (forward-char 1))
+	    ((looking-at "(\\?[^a-zA-Z]")
+	     (forward-char 3))
+	    ((looking-at "(\\?")	; (?i)
+	     (forward-char 2))
+	    (t
+	     (forward-char 1))))
+    (setq c (1- (current-column))
+	  c1 (+ c (or cperl-regexp-indent-step cperl-indent-level)))
+    (or (looking-at "[ \t]*[\n#]")
+	(progn
+	  (insert "\n")))
+    (goto-char e)
+    (beginning-of-line)
+    (if (re-search-forward "[^ \t]" e t)
+	(progn
+	  (goto-char e)
+	  (insert "\n")
+	  (indent-to-column c)
+	  (set-marker e (point))))
+    (goto-char b)
+    (end-of-line 2)
+    (while (< (point) (marker-position e))
+      (beginning-of-line)
+      (setq s (point)
+	    inline t)
+      (skip-chars-forward " \t")
+      (delete-region s (point))
+      (indent-to-column c1)
+      (while (and
+	      inline
+	      (looking-at 
+	       (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1
+		       "\\|"
+		       "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3
+		       "\\|"
+		       "[$^]"
+		       "\\|"
+		       "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5
+		       "\\|"
+		       "\\(\\[\\)"	; 6
+		       "\\|"
+		       "\\((\\(\\?\\)?\\)" ; 7 8
+		       "\\|"
+		       "\\(|\\)"	; 9
+		       )))
+	(goto-char (match-end 0))
+	(setq spaces t)
+	(cond ((match-beginning 1)	; Alphanum word + junk
+	       (forward-char -1))
+	      ((or (match-beginning 3)	; $ab[12]
+		   (and (match-beginning 5) ; X* X+ X{2,3}
+			(eq (preceding-char) ?\{)))
+	       (forward-char -1)
+	       (forward-sexp 1))
+	      ((match-beginning 6)	; []
+	       (setq tmp (point))
+	       (if (looking-at "\\^?\\]")
+		   (goto-char (match-end 0)))
+	       (or (re-search-forward "\\]\\([*+{?]\\)?" e t)
+		   (progn
+		     (goto-char (1- tmp))
+		     (error "[]-group not terminated")))
+	       (if (not (eq (preceding-char) ?\{)) nil
+		 (forward-char -1)
+		 (forward-sexp 1)))
+	      ((match-beginning 7)	; ()
+	       (goto-char (match-beginning 0))
+	       (or (eq (current-column) c1)
+		   (progn
+		     (insert "\n")
+		     (indent-to-column c1)))
+	       (setq tmp (point))
+	       (forward-sexp 1)
+	       ;;	       (or (forward-sexp 1)
+	       ;;		   (progn
+	       ;;		     (goto-char tmp)
+	       ;;		     (error "()-group not terminated")))
+	       (set-marker m (1- (point)))
+	       (set-marker m1 (point))
+	       (cperl-beautify-regexp-piece tmp m t)
+	       (goto-char m1)
+	       (cond ((looking-at "[*+?]\\??")
+		      (goto-char (match-end 0)))
+		     ((eq (following-char) ?\{)
+		      (forward-sexp 1)
+		      (if (eq (following-char) ?\?)
+			  (forward-char))))
+	       (skip-chars-forward " \t")
+	       (setq spaces nil)
+	       (if (looking-at "[#\n]")
+		   (beginning-of-line 2)
+		 (insert "\n"))
+	       (end-of-line)
+	       (setq inline nil))
+	      ((match-beginning 9)	; |
+	       (forward-char -1)
+	       (setq tmp (point))
+	       (beginning-of-line)
+	       (if (re-search-forward "[^ \t]" tmp t)
+		   (progn
+		     (goto-char tmp)
+		     (insert "\n"))
+		 ;; first at line
+		 (delete-region (point) tmp))
+	       (indent-to-column c)
+	       (forward-char 1)
+	       (skip-chars-forward " \t")
+	       (setq spaces nil)
+	       (if (looking-at "[#\n]")
+		   (beginning-of-line 2)
+		 (insert "\n"))
+	       (end-of-line)
+	       (setq inline nil)))
+	(or (looking-at "[ \t\n]")
+	    (not spaces)
+	    (insert " "))
+	(skip-chars-forward " \t"))
+	(or (looking-at "[#\n]")
+	    (error "unknown code in a regexp"))
+	(and inline (end-of-line 2)))
+  ))
+
+(defun cperl-beautify-regexp ()
+  "do it. (Experimental, may change semantics, recheck afterwards.)
+We suppose that the regexp is scanned already."
+  (interactive)
+  (or cperl-use-syntax-table-text-property
+      (error "I need to have regex marked!"))
+  ;; Find the start
+  (re-search-backward "\\s|")		; Assume it is scanned already.
+  ;;(forward-char 1)
+  (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
+	(sub-p (eq (preceding-char) ?s)) s)
+    (forward-sexp 1)
+    (set-marker e (1- (point)))
+    (setq delim (preceding-char))
+    (if (and sub-p (eq delim (char-after (- (point) 2))))
+	(error "Possible s/blah// - do not know how to deal with"))
+    (if sub-p (forward-sexp 1))
+    (if (looking-at "\\sw*x") 
+	(setq have-x t)
+      (insert "x"))
+    ;; Protect fragile " ", "#"
+    (if have-x nil
+	(goto-char (1+ b))
+	(while (re-search-forward "\\(\\=\\|[^\\\\]\\)\\(\\\\\\\\\\)*[ \t\n#]" e t) ; Need to include (?#) too?
+	  (forward-char -1)
+	  (insert "\\")
+	  (forward-char 1)))
+    (cperl-beautify-regexp-piece b e nil)))
+
 (if (fboundp 'run-with-idle-timer)
     (progn
       (defvar cperl-help-shown nil
 	"Non-nil means that the help was already shown now.")
 
-      (defvar cperl-help-timer nil
-	"Non-nil means that the help was already shown now.")
+      (defvar cperl-lazy-installed nil
+	"Non-nil means that the lazy-help handlers are installed now.")
 
       (defun cperl-lazy-install ()
 	(interactive)
 	(make-variable-buffer-local 'cperl-help-shown)
-	(if (cperl-val cperl-lazy-help-time)
+	(if (and (cperl-val 'cperl-lazy-help-time)
+		 (not cperl-lazy-installed))
 	    (progn
 	      (add-hook 'post-command-hook 'cperl-lazy-hook)
-	      (setq cperl-help-timer 
-		    (run-with-idle-timer 
-		     (cperl-val cperl-lazy-help-time 1000000 5) 
-		     t 
-		     'cperl-get-help-defer)))))
+	      (run-with-idle-timer 
+	       (cperl-val 'cperl-lazy-help-time 1000000 5) 
+	       t 
+	       'cperl-get-help-defer)
+	      (setq cperl-lazy-installed t))))
 
       (defun cperl-lazy-unstall ()
 	(interactive)
 	(remove-hook 'post-command-hook 'cperl-lazy-hook)
-	(cancel-timer cperl-help-timer))
+	(cancel-function-timers 'cperl-get-help-defer)
+	(setq cperl-lazy-installed nil))
 
       (defun cperl-lazy-hook ()
 	(setq cperl-help-shown nil))
@@ -4694,3 +5331,5 @@ prototype \&SUB	Returns prototype of the function given a reference.
 	    (cperl-get-help)
 	    (setq cperl-help-shown t))))
       (cperl-lazy-install)))
+
+(provide 'cperl-mode)