Merge changes from CPerl-5.0.

(toplevel): Require man.
(condition-case): Don't autoload tmm-prompt (it's in loaddefs.el).
(cperl-electric-backspace-untabify): New var.
(cperl-electric-backspace): Use it.
(cperl-vc-header-alist): Extract numeric version from the Id.
(cperl-build-manpage): New fun.
(cperl-menu): Use it.  Add toggle-autohelp.
(cperl-mode) <defun-prompt_regexp>: Understand prototypes.
(cperl-electric-brace): Use `cperl-after-block-p' for detection.
(cperl-electric-keyword): Make $if (etc: "$@%&*") non-electric.
'(' after keyword would insert a doubled paren.
(cperl-calculate-indent): Update syntaxification before checks.
Fix wrong indent of blocks starting with POD.
(cperl-find-pods-heres): If no end of HERE-doc found, mark to the end
of buffer.  This enables recognition of end of HERE-doc "as one types".
Require "\n" after trailing tag of HERE-doc.
\( made non-quoting outside of string/comment (gdj-contributed).
Likewise for \$.  Remove `here-doc-group' text property at start
(makes this property reliable).
Text property `first-format-line' ==> t.
Do not recognize $opt_s and $opt::s as s///.
(cperl-after-block-p): Optional arg pre-block to check for a pre-block
Recognize `continue' blocks too.
(cperl-after-expr-p): Update syntaxification before checks.  Work after
here-docs, formats, and PODs too (affects many electric constructs).
(cperl-fix-line-spacing): Allow "_" in $vars of foreach etc.
(cperl-perldoc): Use case-sensitive search.

1 files changed, 263 insertions, 124 deletions

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 4084f824eaa..6ce9bd3d685 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -69,6 +69,9 @@
 
 ;; Some macros are needed for `defcustom'
 (eval-when-compile
+  (condition-case nil
+      (require 'man)
+    (error nil))
   (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
   (defvar cperl-can-font-lock
     (or cperl-xemacs-p
@@ -120,8 +123,7 @@
         `(goto-line (string-to-int (elt ,elt 1))))
     ;;)
     (defmacro cperl-etags-goto-tag-location (elt)
-      `(etags-goto-tag-location ,elt)))
-  (autoload 'tmm-prompt "tmm"))
+      `(etags-goto-tag-location ,elt))))
 
 (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
 
@@ -321,6 +323,11 @@ Can be overwritten by `cperl-hairy' if nil."
   :type '(choice (const null) boolean)
   :group 'cperl-affected-by-hairy)
 
+(defcustom cperl-electric-backspace-untabify t
+  "*Not-nil means electric-backspace will untabify in CPerl."
+  :type 'boolean
+  :group 'cperl-autoinsert-details)
+
 (defcustom cperl-hairy nil
   "*Not-nil means most of the bells and whistles are enabled in CPerl.
 Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
@@ -335,8 +342,8 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
   :type 'integer
   :group 'cperl-indentation-details)
 
-(defcustom cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;")
-                                   (RCS "$rcs = ' $Id\$ ' ;"))
+(defcustom cperl-vc-header-alist '((SCCS "($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
+                                   (RCS "($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;"))
   "*What to use as `vc-header-alist' in CPerl."
   :type '(repeat (list symbol string))
   :group 'cperl)
@@ -1128,57 +1135,58 @@ the faces: please specify bold, italic, underline, shadow and box.)
 ;;;          ["Add tags for Perl files in (sub)directories"
 ;;;           (cperl-etags t 'recursive) t])
 ;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)
-            ["Create tags for current file" (cperl-write-tags nil t) t]
-            ["Add tags for current file" (cperl-write-tags) t]
-            ["Create tags for Perl files in directory"
-             (cperl-write-tags nil t nil t) t]
-            ["Add tags for Perl files in directory"
-             (cperl-write-tags nil nil nil t) t]
-            ["Create tags for Perl files in (sub)directories"
-             (cperl-write-tags nil t t t) t]
-            ["Add tags for Perl files in (sub)directories"
-             (cperl-write-tags nil nil t t) t]))
-          ("Perl docs"
-           ["Define word at point" imenu-go-find-at-position
-            (fboundp 'imenu-go-find-at-position)]
-           ["Help on function" cperl-info-on-command t]
-           ["Help on function at point" cperl-info-on-current-command t]
-           ["Help on symbol at point" cperl-get-help t]
-           ["Perldoc" cperl-perldoc t]
-           ["Perldoc on word at point" cperl-perldoc-at-point t]
-           ["View manpage of POD in this file" cperl-pod-to-manpage t]
-           ["Auto-help on" cperl-lazy-install
-            (and (fboundp 'run-with-idle-timer)
-                 (not cperl-lazy-installed))]
-           ["Auto-help off" (eval '(cperl-lazy-unstall))
-            (and (fboundp 'run-with-idle-timer)
-                 cperl-lazy-installed)])
-          ("Toggle..."
-           ["Auto newline" cperl-toggle-auto-newline t]
-           ["Electric parens" cperl-toggle-electric t]
-           ["Electric keywords" cperl-toggle-abbrev t]
-           ["Fix whitespace on indent" cperl-toggle-construct-fix t]
-           ["Auto fill" auto-fill-mode t])
-          ("Indent styles..."
-           ["CPerl" (cperl-set-style "CPerl") t]
-           ["PerlStyle" (cperl-set-style "PerlStyle") t]
-           ["GNU" (cperl-set-style "GNU") t]
-           ["C++" (cperl-set-style "C++") t]
-           ["FSF" (cperl-set-style "FSF") t]
-           ["BSD" (cperl-set-style "BSD") t]
-           ["Whitesmith" (cperl-set-style "Whitesmith") t]
-           ["Current" (cperl-set-style "Current") t]
-           ["Memorized" (cperl-set-style-back) cperl-old-style])
-          ("Micro-docs"
-           ["Tips" (describe-variable 'cperl-tips) t]
-           ["Problems" (describe-variable 'cperl-problems) t]
-           ["Speed" (describe-variable 'cperl-speed) t]
-           ["Praise" (describe-variable 'cperl-praise) t]
-           ["Faces" (describe-variable 'cperl-tips-faces) t]
-           ["CPerl mode" (describe-function 'cperl-mode) t]
-           ["CPerl version"
-            (message "The version of master-file for this CPerl is %s-emacs"
-                     cperl-version) t]))))
+           ["Create tags for current file" (cperl-write-tags nil t) t]
+           ["Add tags for current file" (cperl-write-tags) t]
+           ["Create tags for Perl files in directory"
+            (cperl-write-tags nil t nil t) t]
+           ["Add tags for Perl files in directory"
+            (cperl-write-tags nil nil nil t) t]
+           ["Create tags for Perl files in (sub)directories"
+            (cperl-write-tags nil t t t) t]
+           ["Add tags for Perl files in (sub)directories"
+            (cperl-write-tags nil nil t t) t]))
+         ("Perl docs"
+          ["Define word at point" imenu-go-find-at-position 
+           (fboundp 'imenu-go-find-at-position)]
+          ["Help on function" cperl-info-on-command t]
+          ["Help on function at point" cperl-info-on-current-command t]
+          ["Help on symbol at point" cperl-get-help t]
+          ["Perldoc" cperl-perldoc t]
+          ["Perldoc on word at point" cperl-perldoc-at-point t]
+          ["View manpage of POD in this file" cperl-build-manpage t]
+          ["Auto-help on" cperl-lazy-install 
+           (and (fboundp 'run-with-idle-timer)
+                (not cperl-lazy-installed))]
+          ["Auto-help off" cperl-lazy-unstall
+           (and (fboundp 'run-with-idle-timer)
+                cperl-lazy-installed)])
+         ("Toggle..."
+          ["Auto newline" cperl-toggle-auto-newline t]
+          ["Electric parens" cperl-toggle-electric t]
+          ["Electric keywords" cperl-toggle-abbrev t]
+          ["Fix whitespace on indent" cperl-toggle-construct-fix t]
+          ["Auto-help on Perl constructs" cperl-toggle-autohelp t]
+          ["Auto fill" auto-fill-mode t]) 
+         ("Indent styles..."
+          ["CPerl" (cperl-set-style "CPerl") t]
+          ["PerlStyle" (cperl-set-style "PerlStyle") t]
+          ["GNU" (cperl-set-style "GNU") t]
+          ["C++" (cperl-set-style "C++") t]
+          ["FSF" (cperl-set-style "FSF") t]
+          ["BSD" (cperl-set-style "BSD") t]
+          ["Whitesmith" (cperl-set-style "Whitesmith") t]
+          ["Current" (cperl-set-style "Current") t]
+          ["Memorized" (cperl-set-style-back) cperl-old-style])
+         ("Micro-docs"
+          ["Tips" (describe-variable 'cperl-tips) t]
+          ["Problems" (describe-variable 'cperl-problems) t]
+          ["Speed" (describe-variable 'cperl-speed) t]
+          ["Praise" (describe-variable 'cperl-praise) t]
+          ["Faces" (describe-variable 'cperl-tips-faces) t]
+          ["CPerl mode" (describe-function 'cperl-mode) t]
+          ["CPerl version"
+           (message "The version of master-file for this CPerl is %s-Emacs"
+                    cperl-version) t]))))
   (error nil))
 
 (autoload 'c-macro-expand "cmacexp"
@@ -1469,7 +1477,7 @@ or as help on variables `cperl-tips', `cperl-problems',
   (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "#+ *")
   (make-local-variable 'defun-prompt-regexp)
-  (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)[ \t]*")
+  (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)\\([ \t]*([^()]*)[ \t]*\\)?[ \t]*")
   (make-local-variable 'comment-indent-function)
   (setq comment-indent-function 'cperl-comment-indent)
   (make-local-variable 'parse-sexp-ignore-comments)
@@ -1692,7 +1700,9 @@ char is \"{\", insert extra newline before only if
                     (save-excursion
                       (up-list (- (prefix-numeric-value arg)))
                       ;;(cperl-after-block-p (point-min))
-                      (cperl-after-expr-p nil "{;)"))
+                      (or (cperl-after-expr-p nil "{;)")
+                          ;; after sub, else, continue
+                          (cperl-after-block-p nil 'pre)))
                   (error nil))))
           ;; Just insert the guy
           (self-insert-command (prefix-numeric-value arg))
@@ -1772,7 +1782,8 @@ char is \"{\", insert extra newline before only if
                 (goto-char pos)))))
 
 (defun cperl-electric-paren (arg)
-  "Insert a matching pair of parentheses."
+  "Insert an opening parenthesis or a matching pair of parentheses.
+See `cperl-electric-parens'."
   (interactive "P")
   (let ((beg (save-excursion (beginning-of-line) (point)))
         (other-end (if (and cperl-electric-parens-mark
@@ -1807,7 +1818,8 @@ char is \"{\", insert extra newline before only if
 
 (defun cperl-electric-rparen (arg)
   "Insert a matching pair of parentheses if marking is active.
-If not, or if we are not at the end of marking range, would self-insert."
+If not, or if we are not at the end of marking range, would self-insert.
+Affected by `cperl-electric-parens'."
   (interactive "P")
   (let ((beg (save-excursion (beginning-of-line) (point)))
         (other-end (if (and cperl-electric-parens-mark
@@ -1867,6 +1879,8 @@ to nil."
                                    (not (eq (get-text-property (point)
                                                                'syntax-type)
                                             'pod))))))
+         (save-excursion (forward-sexp -1)
+                         (not (memq (following-char) (append "$@%&*" nil))))
          (progn
            (and (eq (preceding-char) ?y)
                 (progn                  ; "foreachmy"
@@ -1896,7 +1910,11 @@ to nil."
                              (if my
                                  (forward-char 1)
                                (delete-char 1)))
-             (search-backward ")"))
+             (search-backward ")")
+             (if (eq last-command-char ?\()
+                 (progn                 ; Avoid "if (())"
+                   (delete-backward-char 1)
+                   (delete-backward-char -1))))
            (if delete
                (cperl-putback-char cperl-del-back-ch))
            (if cperl-message-electric-keyword
@@ -2185,8 +2203,8 @@ If in POD, insert appropriate lines."
       (self-insert-command (prefix-numeric-value arg)))))
 
 (defun cperl-electric-backspace (arg)
-  "Backspace-untabify, or remove the whitespace around the point inserted
-by an electric key."
+  "Backspace, or remove the whitespace around the point inserted by an electric
+key.  Will untabify if `cperl-electric-backspace-untabify' is non-nil."
   (interactive "p")
   (if (and cperl-auto-newline
            (memq last-command '(cperl-electric-semi
@@ -2210,7 +2228,9 @@ by an electric key."
           (setq p (point))
           (skip-chars-backward " \t\n")
           (delete-region (point) p))
-      (backward-delete-char-untabify arg))))
+      (if cperl-electric-backspace-untabify
+          (backward-delete-char-untabify arg)
+        (delete-backward-char arg)))))
 
 (defun cperl-inside-parens-p ()
   (condition-case ()
@@ -2370,6 +2390,7 @@ Returns nil if line starts inside a string, t if in a comment.
 
 Will not correct the indentation for labels, but will correct it for braces
 and closing parentheses and brackets."
+  (cperl-update-syntaxification (point) (point))
   (save-excursion
     (if (or
          (and (memq (get-text-property (point) 'syntax-type)
@@ -2467,7 +2488,8 @@ and closing parentheses and brackets."
                                    (progn
                                      (forward-sexp -1)
                                      (skip-chars-backward " \t")
-                                     (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))))
+                                     (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
+                              (get-text-property (point) 'first-format-line))
                           (progn
                             (if (and parse-data
                                      (not (eq char-after ?\C-j)))
@@ -2545,7 +2567,8 @@ and closing parentheses and brackets."
                                     (append (if is-block " ;{" " ,;{") '(nil)))
                               (and (eq (preceding-char) ?\})
                                    (cperl-after-block-and-statement-beg
-                                    containing-sexp))))
+                                    containing-sexp))
+                              (get-text-property (point) 'first-format-line)))
                      ;; This line is continuation of preceding line's statement;
                      ;; indent  `cperl-continued-statement-offset'  more than the
                      ;; previous line of the statement.
@@ -2586,11 +2609,16 @@ and closing parentheses and brackets."
                       (forward-char 1)
                       (setq old-indent (current-indentation))
                       (let ((colon-line-end 0))
-                        (while (progn (skip-chars-forward " \t\n")
-                                      (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]"))
+                        (while
+                            (progn (skip-chars-forward " \t\n")
+                                   (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]"))
                           ;; Skip over comments and labels following openbrace.
                           (cond ((= (following-char) ?\#)
                                  (forward-line 1))
+                                ((= (following-char) ?\=)
+                                 (goto-char
+                                  (or (next-single-property-change (point) 'in-pod)
+                                      (point-max)))) ; do not loop if no syntaxification
                                 ;; label:
                                 (t
                                  (save-excursion (end-of-line)
@@ -3050,7 +3078,8 @@ Returns true if comment is found."
 ;;              The body is marked `syntax-type' ==> `here-doc'
 ;;              The delimiter is marked `syntax-type' ==> `here-doc-delim'
 ;;      c) FORMATs:
-;;              After-initial-line--to-end is marked `syntax-type' ==> `format'
+;;              First line (to =) marked `first-format-line' ==> t
+;;              After-this--to-end is marked `syntax-type' ==> `format'
 ;;      d) 'Q'uoted string:
 ;;              part between markers inclusive is marked `syntax-type' ==> `string'
 ;;              part between `q' and the first marker is marked `syntax-type' ==> `prestring'
@@ -3147,7 +3176,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
            "\\([^\"'`\n]*\\)"           ; 3 + 1
            "\\3"
            "\\|"
-           ;; Second variant: Identifier or \ID or empty
+           ;; Second variant: Identifier or \ID (same as 'ID') or empty
            "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
            ;; Do not have <<= or << 30 or <<30 or << $blah.
            ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
@@ -3178,7 +3207,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                 "__\\(END\\|DATA\\)__"
                 ;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
                 "\\|"
-                "\\\\\\(['`\"]\\)")
+                "\\\\\\(['`\"($]\\)")
              ""))))
     (unwind-protect
         (progn
@@ -3195,6 +3224,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                                   cperl-postpone t
                                                   syntax-subtype t
                                                   rear-nonsticky t
+                                                  here-doc-group t
+                                                  first-format-line t
                                                   indentable t))
             ;; Need to remove face as well...
             (goto-char min)
@@ -3239,7 +3270,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                           max e '(syntax-type t in-pod t syntax-table t
                                               cperl-postpone t
                                               syntax-subtype t
+                                              here-doc-group t
                                               rear-nonsticky t
+                                              first-format-line t
                                               indentable t))
                          (setq tmpend tb)))
                   (put-text-property b e 'in-pod t)
@@ -3287,6 +3320,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                ;;"<<"
                ;;  "\\("                        ; 1 + 1
                ;;  ;; First variant "BLAH" or just ``.
+               ;;     "[ \t]*"                  ; Yes, whitespace is allowed!
                ;;     "\\([\"'`]\\)"    ; 2 + 1
                ;;     "\\([^\"'`\n]*\\)"        ; 3 + 1
                ;;     "\\3"
@@ -3328,30 +3362,34 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                   (setq b (point))
                   ;; We do not search to max, since we may be called from
                   ;; some hook of fontification, and max is random
-                  (cond ((re-search-forward (concat "^" qtag "$")
-                                            stop-point 'toend)
-                         (if cperl-pod-here-fontify
-                             (progn
-                               ;; Highlight the ending delimiter
-                               (cperl-postpone-fontification (match-beginning 0) (match-end 0)
-                                                             'face font-lock-constant-face)
-                               (cperl-put-do-not-fontify b (match-end 0) t)
-                               ;; Highlight the HERE-DOC
-                               (cperl-postpone-fontification 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)
-                         (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)
-                         (if (> e1 max)
-                             (setq tmpend tb)))
-                        (t (message "End of here-document `%s' not found." tag)
-                           (or (car err-l) (setcar err-l b))))))
+                  (or (and (re-search-forward (concat "^" qtag "$")
+                                              stop-point 'toend)
+                           (eq (following-char) ?\n))
+                    (progn              ; Pretend we matched at the end
+                      (goto-char (point-max))
+                      (re-search-forward "\\'")
+                      (message "End of here-document `%s' not found." tag)
+                      (or (car err-l) (setcar err-l b))))
+                  (if cperl-pod-here-fontify
+                      (progn
+                        ;; Highlight the ending delimiter
+                        (cperl-postpone-fontification (match-beginning 0) (match-end 0)
+                                                      'face font-lock-constant-face)
+                        (cperl-put-do-not-fontify b (match-end 0) t)
+                        ;; Highlight the HERE-DOC
+                        (cperl-postpone-fontification 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)
+                  (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)
+                  (if (> e1 max)
+                      (setq tmpend tb))))
                ;; format
                ((match-beginning 8)
                 ;; 1+6=7 extra () before this:
@@ -3363,6 +3401,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                              "")
                       tb (match-beginning 0))
                 (setq argument nil)
+                (put-text-property (save-excursion
+                                     (beginning-of-line)
+                                     (point))
+                                   b 'first-format-line 't)
                 (if cperl-pod-here-fontify
                     (while (and (eq (forward-line) 0)
                                 (not (looking-at "^[.;]$")))
@@ -3415,13 +3457,21 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                       bb (char-after (1- (match-beginning b1))) ; tmp holder
                       ;; bb == "Not a stringy"
                       bb (if (eq b1 10) ; user variables/whatever
-                             (or
-                              (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
-                              (and (eq bb ?-) (eq c ?s)) ; -s file test
-                              (and (eq bb ?\&)
-                                   (not (eq (char-after ; &&m/blah/
-                                             (- (match-beginning b1) 2))
-                                            ?\&))))
+                             (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
+                                  (cond ((eq bb ?-) (eq c ?s)) ; -s file test
+                                        ((eq bb ?\:) ; $opt::s
+                                         (eq (char-after
+                                              (- (match-beginning b1) 2))
+                                             ?\:))
+                                        ((eq bb ?\>) ; $foo->s
+                                         (eq (char-after
+                                              (- (match-beginning b1) 2))
+                                             ?\-))
+                                        ((eq bb ?\&)
+                                         (not (eq (char-after   ; &&m/blah/
+                                                   (- (match-beginning b1) 2))
+                                                  ?\&)))
+                                        (t t)))
                            ;; <file> or <$file>
                            (and (eq c ?\<)
                                 ;; Do not stringify <FH>, <$fh> :
@@ -3434,6 +3484,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                 (or bb
                     (if (eq b1 11)      ; bare /blah/ or ?blah? or <foo>
                         (setq argument ""
+                              b1 nil
                               bb        ; Not a regexp?
                               (progn
                                 (not
@@ -3472,16 +3523,58 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                           (looking-at "\\s|")))))))
                               b (1- b))
                       ;; s y tr m
-                      ;; Check for $a->y
-                      (if (and (eq (preceding-char) ?>)
-                               (eq (char-after (- (point) 2)) ?-))
+                      ;; Check for $a -> y
+                      (setq b1 (preceding-char)
+                            go (point))
+                      (if (and (eq b1 ?>)
+                               (eq (char-after (- go 2)) ?-))
                           ;; Not a regexp
                           (setq bb t))))
                 (or bb (setq state (parse-partial-sexp
                                     state-point b nil nil state)
                              state-point b))
+                (setq bb (or bb (nth 3 state) (nth 4 state)))
                 (goto-char b)
-                (if (or bb (nth 3 state) (nth 4 state))
+                (or bb
+                    (progn
+                      (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
+                          (goto-char (match-end 0))
+                        (skip-chars-forward " \t\n\f"))
+                      (cond ((and (eq (following-char) ?\})
+                                  (eq b1 ?\{))
+                             ;; Check for $a[23]->{ s }, @{s} and *{s::foo}
+                             (goto-char (1- go))
+                             (skip-chars-backward " \t\n\f")
+                             (if (memq (preceding-char) (append "$@%&*" nil))
+                                 (setq bb t) ; @{y}
+                               (condition-case nil
+                                   (forward-sexp -1)
+                                 (error nil)))
+                             (if (or bb
+                                     (looking-at ; $foo -> {s}
+                                      "[$@]\\$*\\([a-zA-Z0-9_:]+\\|[^{]\\)\\([ \t\n]*->\\)?[ \t\n]*{")
+                                     (and ; $foo[12] -> {s}
+                                      (memq (following-char) '(?\{ ?\[))
+                                      (progn
+                                        (forward-sexp 1)
+                                        (looking-at "\\([ \t\n]*->\\)?[ \t\n]*{"))))
+                                 (setq bb t)
+                               (goto-char b)))
+                            ((and (eq (following-char) ?=)
+                                  (eq (char-after (1+ (point))) ?\>))
+                             ;; Check for { foo => 1, s => 2 }
+                             ;; Apparently s=> is never a substitution...
+                             (setq bb t))
+                            ((and (eq (following-char) ?:)
+                                  (eq b1 ?\{) ; Check for $ { s::bar }
+                                  (looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}")
+                                  (progn 
+                                    (goto-char (1- go))
+                                    (skip-chars-backward " \t\n\f")
+                                    (memq (preceding-char)
+                                          (append "$@%&*" nil))))
+                             (setq bb t)))))
+                (if bb
                     (goto-char i)
                   ;; Skip whitespace and comments...
                   (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
@@ -3703,7 +3796,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                   (cperl-commentify b bb nil)
                   (setq end t))
                 (goto-char bb))
-               ((match-beginning 17)    ; "\\\\\\(['`\"]\\)"
+               ((match-beginning 17)    ; "\\\\\\(['`\"($]\\)"
+                ;; Trailing backslash ==> non-quoting outside string/comment
                 (setq bb (match-end 0)
                       b (match-beginning 0))
                 (goto-char b)
@@ -3752,19 +3846,22 @@ 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)
+(defun cperl-after-block-p (lim &optional pre-block)
+  "Return true if the preceeding } ends a block or a following { starts one.
+Would not look before LIM.  If PRE-BLOCK is nil checks preceeding }.
+otherwise following {."
   ;; We suppose that the preceding char is }.
   (save-excursion
     (condition-case nil
         (progn
-          (forward-sexp -1)
+          (or pre-block (forward-sexp -1))
           (cperl-backward-to-noncomment lim)
           (or (eq (point) lim)
               (eq (preceding-char) ?\) ) ; if () {}    sub f () {}
               (if (eq (char-syntax (preceding-char)) ?w) ; else {}
                   (save-excursion
                     (forward-sexp -1)
-                    (or (looking-at "\\(else\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
+                    (or (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
                         ;; sub f {}
                         (progn
                           (cperl-backward-to-noncomment lim)
@@ -3781,15 +3878,28 @@ TEST is the expression to evaluate at the found position.  If absent,
 CHARS is a string that contains good characters to have before us (however,
 `}' is treated \"smartly\" if it is not in the list)."
   (let ((lim (or lim (point-min)))
-        stop p)
+        stop p pr)
+    (cperl-update-syntaxification (point) (point))
     (save-excursion
       (while (and (not stop) (> (point) lim))
         (skip-chars-backward " \t\n\f" lim)
         (setq p (point))
         (beginning-of-line)
+        ;;(memq (setq pr (get-text-property (point) 'syntax-type))
+        ;;      '(pod here-doc here-doc-delim))
+        (if (get-text-property (point) 'here-doc-group)
+            (progn
+              (goto-char
+               (previous-single-property-change (point) 'here-doc-group))
+              (beginning-of-line 0)))
+        (if (get-text-property (point) 'in-pod)
+            (progn
+              (goto-char
+               (previous-single-property-change (point) 'in-pod))
+              (beginning-of-line 0)))
         (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
           ;; Else: last iteration, or a label
-          (cperl-to-comment-or-eol)
+          (cperl-to-comment-or-eol)     ; Will not move past "." after a format
           (skip-chars-backward " \t")
           (if (< p (point)) (goto-char p))
           (setq p (point))
@@ -3808,7 +3918,10 @@ CHARS is a string that contains good characters to have before us (however,
             (if test (eval test)
               (or (memq (preceding-char) (append (or chars "{;") nil))
                   (and (eq (preceding-char) ?\})
-                       (cperl-after-block-p lim)))))))))
+                       (cperl-after-block-p lim))
+                  (and (eq (following-char) ?.) ; in format: see comment above
+                       (eq (get-text-property (point) 'syntax-type)
+                           'format)))))))))
 
 (defun cperl-backward-to-start-of-continued-exp (lim)
   (if (memq (preceding-char) (append ")]}\"'`" nil))
@@ -3931,7 +4044,7 @@ Returns some position at the last line."
         (if (looking-at
              "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
             (progn
-              (forward-word 3)
+              (forward-sexp 3)
               (delete-horizontal-space)
               (insert
                (make-string cperl-indent-region-fix-constructs ?\ ))
@@ -5394,13 +5507,13 @@ in subdirectories too."
            (if (cperl-val 'cperl-electric-parens) "" "not ")))
 
 (defun cperl-toggle-autohelp ()
-  "Toggle the state of automatic help message in CPerl mode.
-See `cperl-lazy-help-time' too."
+  "Toggle the state of Auto-Help on Perl constructs (put in the message area).
+Delay of auto-help controlled by `cperl-lazy-help-time'."
   (interactive)
   (if (fboundp 'run-with-idle-timer)
       (progn
         (if cperl-lazy-installed
-            (eval '(cperl-lazy-unstall))
+            (cperl-lazy-unstall)
           (cperl-lazy-install))
         (message "Perl help messages will %sbe automatically shown now."
                  (if cperl-lazy-installed "" "not ")))
@@ -6131,12 +6244,13 @@ than a line.  Your contribution to update/shorten it is appreciated."
 (defvar cperl-short-docs 'please-ignore-this-line
   ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)
   "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
+...     Range (list context); flip/flop [no flop when flip] (scalar context).
 ! ...   Logical negation.
 ... != ...      Numeric inequality.
 ... !~ ...      Search pattern, substitution, or translation (negated).
 $!      In numeric context: errno.  In a string context: error string.
 $\"     The separator which joins elements of arrays interpolated in strings.
-$#      The output format for printed numbers.  Initial value is %.15g or close.
+$#      The output format for printed numbers.  Default is %.15g or close.
 $$      Process number of this script.  Changes in the fork()ed child process.
 $%      The current page number of the currently selected output channel.
 
@@ -6163,7 +6277,7 @@ $,	The output field separator for the print operator.
 $-      The number of lines left on the page.
 $.      The current input line number of the last filehandle that was read.
 $/      The input record separator, newline by default.
-$0      Name of the file containing the perl script being executed.  May be set.
+$0      Name of the file containing the current perl script (read/write).
 $:     String may be broken after these characters to fill ^-lines in a format.
 $;      Subscript separator for multi-dim array emulation.  Default \"\\034\".
 $<      The real uid of this process.
@@ -6240,12 +6354,12 @@ $~	The name of the current report format.
 -x      File is executable by effective uid.
 -z      File has zero size.
 .       Concatenate strings.
-..      Alternation, also range operator.
+..      Range (list context); flip/flop (scalar context) operator.
 .=      Concatenate assignment strings
 ... / ...       Division.       /PATTERN/ioxsmg Pattern match
 ... /= ...      Division assignment.
 /PATTERN/ioxsmg Pattern match.
-... < ...       Numeric less than.      <pattern>       Glob.   See <NAME>, <> as well.
+... < ...    Numeric less than. <pattern>       Glob.   See <NAME>, <> as well.
 <NAME>  Reads line from filehandle NAME (a bareword or dollar-bareword).
 <pattern>       Glob (Unless pattern is bareword/dollar-bareword - see <NAME>).
 <>      Reads line from union of files in @ARGV (= command line) and STDIN.
@@ -6263,7 +6377,7 @@ $~	The name of the current report format.
 ?PATTERN?       One-time pattern match.
 @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.
+@_    Parameter array for subroutines; result of split() unless in list context.
 \\  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.
@@ -6969,14 +7083,21 @@ We suppose that the regexp is scanned already."
                  default-entry)
              input))))
   (require 'man)
-  (let* ((is-func (and
+  (let* ((case-fold-search nil)
+         (is-func (and
                    (string-match "^[a-z]+$" word)
                    (string-match (concat "^" word "\\>")
                                  (documentation-property
                                   'cperl-short-docs
                                   'variable-documentation))))
          (manual-program (if is-func "perldoc -f" "perldoc")))
-    (Man-getpage-in-background word)))
+    (cond
+     (cperl-xemacs-p
+      (let ((Manual-program "perldoc")
+            (Manual-switches (if is-func (list "-f"))))
+        (manual-entry word)))
+     (t
+      (Man-getpage-in-background word)))))
 
 (defun cperl-perldoc-at-point ()
   "Run a `perldoc' on the word around point."
@@ -7006,6 +7127,19 @@ We suppose that the regexp is scanned already."
                         (format (cperl-pod2man-build-command) pod2man-args))
          'Man-bgproc-sentinel)))))
 
+;;; Updated version by him too
+(defun cperl-build-manpage ()
+  "Create a virtual manpage in Emacs from the POD in the file."
+  (interactive)
+  (require 'man)
+  (cond
+   (cperl-xemacs-p
+    (let ((Manual-program "perldoc"))
+      (manual-entry buffer-file-name)))
+   (t
+    (let* ((manual-program "perldoc"))
+      (Man-getpage-in-background buffer-file-name)))))
+
 (defun cperl-pod2man-build-command ()
   "Builds the entire background manpage and cleaning command."
   (let ((command (concat pod2man-program " %s 2>/dev/null"))
@@ -7024,6 +7158,7 @@ We suppose that the regexp is scanned already."
     command))
 
 (defun cperl-lazy-install ())           ; Avoid a warning
+(defun cperl-lazy-unstall ())           ; Avoid a warning
 
 (if (fboundp 'run-with-idle-timer)
     (progn
@@ -7034,6 +7169,8 @@ We suppose that the regexp is scanned already."
         "Non-nil means that the lazy-help handlers are installed now.")
 
       (defun cperl-lazy-install ()
+        "Switches on Auto-Help on Perl constructs (put in the message area).
+Delay of auto-help controlled by `cperl-lazy-help-time'."
         (interactive)
         (make-variable-buffer-local 'cperl-help-shown)
         (if (and (cperl-val 'cperl-lazy-help-time)
@@ -7047,6 +7184,8 @@ We suppose that the regexp is scanned already."
               (setq cperl-lazy-installed t))))
 
       (defun cperl-lazy-unstall ()
+        "Switches off Auto-Help on Perl constructs (put in the message area).
+Delay of auto-help controlled by `cperl-lazy-help-time'."
         (interactive)
         (remove-hook 'post-command-hook 'cperl-lazy-hook)
         (cancel-function-timers 'cperl-get-help-defer)
@@ -7123,7 +7262,7 @@ We suppose that the regexp is scanned already."
           (cperl-fontify-syntaxically to)))))
 
 (defvar cperl-version
-  (let ((v  "Revision: 4.35"))
+  (let ((v  "Revision: 5.0"))
     (string-match ":\\s *\\([0-9.]+\\)" v)
     (substring v (match-beginning 1) (match-end 1)))
   "Version of IZ-supported CPerl package this file is based on.")