Newer CPerl mode
Ilya Zakharevich [Thu, 8 May 1997 00:32:46 +0000 (20:32 -0400)]
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

emacs/cperl-mode.el

index 6fa07ad..017a7a2 100644 (file)
@@ -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.
 ;;;; 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.
 
 ;;;; 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))
+\f
 (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.")
+
 \f
 
 ;;; 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;
+")
+
 \f
 
 ;;; 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 )
+)
 
 
 \f
@@ -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)))))
 
 \f
@@ -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)