1. xemacs
  2. perl-modes

Commits

malcolmp  committed 8ae5e7f

cperl-mode.el: Sync with upstream version 5.0.

  • Participants
  • Parent commits 578ddfa
  • Branches default

Comments (0)

Files changed (2)

File ChangeLog

View file
+2005-04-21  Malcolm Purvis  <malcolmp@xemacs.org>
+
+	* cperl-mode.el: Sync with upstream version 5.0.
+
 2005-02-10  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.07 released.

File cperl-mode.el

View file
 
 ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2003
 ;;     Free Software Foundation, Inc.
-;; Copyright (C) 1997 granted to FSF for changes made by
-;; Karl M. Hegbloom <karlheg@inetarena.com>
 
 ;; Author: Ilya Zakharevich and Bob Olson
 ;; Maintainer: XEmacs Development Team <xemacs@xemacs.org>
 ;; Keywords: languages, Perl
 
-;; This file is part of XEmacs. It may be distributed either under the
-;; same terms as XEmacs, or under the same terms as Perl. You should
-;; have received a copy of Perl Artistic license along with the Perl
-;; distribution.
-
-;; XEmacs is free software; you can redistribute it and/or modify
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; This file is part of GNU Emacs.
 
 ;;; This code started from the following message of long time ago
 ;;; (IZ), but Bob does not maintain this mode any more:
 ;;;  (`cperl-next-bad-style'):  Fix misprints in character literals
 
 ;;;; After 4.33:
-;;;;  (`cperl-font-lock-keywords'): +etc: Aliased to perl-font-lock-keywords.
+;;;  (`cperl-font-lock-keywords'): +etc: Aliased to perl-font-lock-keywords.
 
 ;;;; After 4.34:
-;;;;  Further updates of whitespace and spelling w.r.t. RMS version.
-;;;;  (`cperl-font-lock-keywords'): +etc: Avoid warnings when aliasing.
-;;;;  (`cperl-mode'):		Use `normal-auto-fill-function' if present.
-;;;;  (`cperl-use-major-mode'): New variable
-;;;;  (`cperl-can-font-lock'):	New variable; replaces `window-system'
-;;;;  (`display-popup-menus-p'): use `display-popup-menus-p' (if present)
-;;;;				 to choose `x-popup-menu' vs `tmm-prompt'
+;;;  Further updates of whitespace and spelling w.r.t. RMS version.
+;;;  (`cperl-font-lock-keywords'): +etc: Avoid warnings when aliasing.
+;;;  (`cperl-mode'):		Use `normal-auto-fill-function' if present.
+;;;  (`cperl-use-major-mode'):	New variable
+;;;  (`cperl-can-font-lock'):	New variable; replaces `window-system'
+;;;  (`cperl-tags-hier-init'):	use `display-popup-menus-p' (if present)
+;;;				to choose `x-popup-menu' vs `tmm-prompt'
+
+;;;; 4.35 has the following differences from version 1.40+ of RMS Emacs:
+
+;;; New variables `cperl-use-major-mode', `cperl-can-font-lock';
+;;; `cperl-use-major-mode' is (effectively) 'cperl-mode in RMS.
+;;; `cperl-under-as-char'  is nil in RMS.
+;;; Minor differences in docstrings, and `cperl-non-problems'.
+;;; Backward compatibility addressed: (`); (function (lambda ...)); font-lock;
+;;; (:italic t bold t) vs (:slant italic :weight bold) in faces;
+;;; `normal-auto-fill-function'.
+;;; RMS version has wrong logic in `cperl-calculate-indent': $a = { } is
+;;; wrongly indented if the closing brace is on a separate line.
+;;; Different choice of ordering if's for is-x-REx and (eq (char-after b) ?\#)
+;;; in `cperl-find-pods-heres'. [Cosmetic]
+
+;;;; After 4.35:
+;;;  (`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-perldoc'):		Use case-sensitive search (contributed).
+;;;  (`cperl-fix-line-spacing'): Allow "_" in $vars of foreach etc. when
+;;;				underscore isn't a word char (gdj-contributed).
+;;;  (`defun-prompt-regexp'):	Allow prototypes.
+;;;  (`cperl-vc-header-alist'):	Extract numeric version from the Id.
+;;;  Toplevel:			Put toggle-autohelp into the mode menu.
+;;;				Better docs for toggle/set/unset autohelp.
+;;;  (`cperl-electric-backspace-untabify'): New customization variable
+;;;  (`cperl-after-expr-p'):	Works after here-docs, formats, and PODs too
+;;;				(affects many electric constructs).
+;;;  (`cperl-calculate-indent'): Takes into account `first-format-line' ==>
+;;;				works after format.
+;;;  (`cperl-short-docs'):	Make it work with ... too.
+;;;				"array context" ==> "list context"
+;;;  (`cperl-electric-keyword'): make $if (etc: "$@%&*") non-electric
+;;;				'(' after keyword would insert a doubled paren
+;;;  (`cperl-electric-paren'):	documented affected by `cperl-electric-parens'
+;;;  (`cperl-electric-rparen'):	Likewise
+;;;  (`cperl-build-manpage'):	New function by Nick Roberts
+;;;  (`cperl-perldoc'):		Make it work in XEmacs too
+
+;;;; After 4.36:
+;;;  (`cperl-find-pods-heres'):	Recognize s => 1 and {s} (as a key or varname),
+;;;				{ s:: } and { s::bar::baz } as varnames.
+;;;  (`cperl-after-expr-p'):	Updates syntaxification before checks
+;;;  (`cperl-calculate-indent'): Likewise
+;;;				Fix wrong indent of blocks starting with POD
+;;;  (`cperl-after-block-p'):	Optional argument for checking for a pre-block
+;;;				Recognize `continue' blocks too.
+;;;  (`cperl-electric-brace'):	use `cperl-after-block-p' for detection;
+;;;				Now works for else/continue/sub blocks
+;;;  (`cperl-short-docs'):	Minor edits; make messages fit 80-column screen
+
+;;;; After 4.37:
+;;;  `cperl-add-tags-recurse-noxs-fullpath'
+;;;    added (for -batch mode);
 
 ;;; Code:
 
       (condition-case nil
 	  (require 'custom)
 	(error nil))
+      (condition-case nil
+	  (require 'man)
+	(error nil))
       (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
       (defvar cperl-can-font-lock
 	(or cperl-xemacs-p
   :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',
   :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)
 via `cperl-use-syntax-table-text-property'.")
 
 (defvar cperl-non-problems 'please-ignore-this-line
-  "As you know from `problems' section, Perl syntax is too hard for CPerl on
+"As you know from `problems' section, Perl syntax is too hard for CPerl on 
 older Emacsen.  Here is what you can do if you cannot upgrade, or if
 you want to switch off these capabilities on Emacs 20.2 (+patches) or 20.3
 or better.  Please skip this docs if you run a capable Emacs already.
 	  ["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]
+	  ["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" (eval '(cperl-lazy-unstall)) 
+	  ["Auto-help off" cperl-lazy-unstall
 	   (and (fboundp 'run-with-idle-timer)
 		cperl-lazy-installed)])
 	 ("Toggle..."
 	  ["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]
   (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)
 		    (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))
 		(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
 
 (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
 				   (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"
 			     (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
       (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 untabivy if `cperl-electric-backspace-untabify' is non-nil."
   (interactive "p")
   (if (and cperl-auto-newline
 	   (memq last-command '(cperl-electric-semi
 	  (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)))))
 
 ;; XEmacs addition
 ;; helper function for deletion, which honors the desired delete direction
 
 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)
 				   (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)))
 				    (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.
 		      (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)
 ;;		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'
 	   "\\([^\"'`\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
 		"__\\(END\\|DATA\\)__"
 		;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
 		"\\|"
-		"\\\\\\(['`\"]\\)")
+		"\\\\\\(['`\"($]\\)")
 	     ""))))
     (unwind-protect
 	(progn
 						  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)
 			  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)
 	       ;;"<<"
 	       ;;  "\\("			; 1 + 1
 	       ;;  ;; First variant "BLAH" or just ``.
+	       ;;     "[ \t]*"			; Yes, whitespace is allowed!
 	       ;;     "\\([\"'`]\\)"	; 2 + 1
 	       ;;     "\\([^\"'`\n]*\\)"	; 3 + 1
 	       ;;     "\\3"
 		  (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:
 			     "")
 		      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 "^[.;]$")))
 		      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> :
 		(or bb
 		    (if (eq b1 11)	; bare /blah/ or ?blah? or <foo>
 			(setq argument ""
+			      b1 nil
 			      bb	; Not a regexp?
 			      (progn
 				(not
 					  (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]*\\)+")
 		  (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)
 	    (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)
 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))
 	    (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))
 	(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 ?\ ))
 		    (append t-font-lock-keywords-1
 			    (list '("[$*]{?\\(\\sw+\\)" 1
 				    font-lock-variable-name-face)))))
-	  (setq perl-font-lock-keywords-1
+	  (setq perl-font-lock-keywords-1 
 		(if cperl-syntaxify-by-font-lock
 		    (cons 'cperl-fontify-update
 			  t-font-lock-keywords)
 Chosing \"Current\" style will not change style, so this may be used for
 side-effect of memorizing only."
   (interactive
-   (let ((list (mapcar (function (lambda (elt) (list (car elt))))
+   (let ((list (mapcar (function (lambda (elt) (list (car elt)))) 
 		       cperl-style-alist)))
      (list (completing-read "Enter style: " list nil 'insist))))
   (or cperl-old-style
 	   (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 ")))
 	ret))))
 
 (defun cperl-add-tags-recurse-noxs ()
-  "Add to TAGS data for Perl and XSUB files in the current directory and kids.
-Use as
+  "Add to TAGS data for Perl (skipping XSUBs) in the current directory 
+and kids. Use as
   emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
-        -f cperl-add-tags-recurse
+        -f cperl-add-tags-recurse-noxs
 "
   (cperl-write-tags nil nil t t nil t))
 
+(defun cperl-add-tags-recurse-noxs-fullpath ()
+  "Add to TAGS data for Perl (skipping XSUBs) in the current directory 
+and kids, using fullpath, so TAGS is relocatable. Use as
+  emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+        -f cperl-add-tags-recurse-noxs-fullpath
+"
+  (cperl-write-tags nil nil t t nil t ""))
+
 (defun cperl-add-tags-recurse ()
   "Add to TAGS file data for Perl files in the current directory and kids.
 Use as
 			(setq cperl-unreadable-ok t
 			      tm nil)	; Return empty list
 		      (error "Aborting: unreadable directory %s" file)))))))
-	  (mapcar (function
+	  (mapcar (function 
 		   (lambda (file)
 		     (cond
 		      ((string-match cperl-noscan-files-regexp file)
 	      (cperl-tags-hier-fill))
 	  (or tags-table-list
 	      (call-interactively 'visit-tags-table))
-	  (mapcar
+	  (mapcar 
 	   (function
 	    (lambda (tagsfile)
 	      (message "Updating list of classes... %s" tagsfile)
 	 l1 head tail cons1 cons2 ord writeto packs recurse
 	 root-packages root-functions ms many_ms same_name ps
 	 (move-deeper
-	  (function
+	  (function 
 	   (lambda (elt)
 	     (cond ((and (string-match regexp (car elt))
 			 (or (eq ord 1) (match-end 2)))
 		    (setq head (substring (car elt) 0 (match-end 1))
-			  tail (if (match-end 2) (substring (car elt)
+			  tail (if (match-end 2) (substring (car elt) 
 							    (match-end 2)))
 			  recurse t)
 		    (if (setq cons1 (assoc head writeto)) nil
 		(cdr to)))
     ;;Now clean up leaders with one child only
     (mapcar (function (lambda (elt)
-			(if (not (and (listp (cdr elt))
+			(if (not (and (listp (cdr elt)) 
 				      (eq (length elt) 2))) nil
 			    (setcar elt (car (nth 1 elt)))
 			    (setcdr elt (cdr (nth 1 elt))))))
 	      root-functions))
     ;; Now add back packages removed from display
     (mapcar (function (lambda (elt)
-			(setcdr to (cons (cons (concat "package " (car elt))
-					       (cdr elt))
+			(setcdr to (cons (cons (concat "package " (car elt)) 
+					       (cdr elt)) 
 					 (cdr to)))))
 	    (if (default-value 'imenu-sort-function)
 		(nreverse
   "Finds places such that insertion of a whitespace may help a lot.")
 
 (defvar cperl-not-bad-style-regexp
-  (mapconcat
+  (mapconcat 
    'identity
    '("[^-\t <>=+]\\(--\\|\\+\\+\\)"	; var-- var++
      "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]"	; abc|def abc&def are often used.
 (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.
 
 $-	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.
 -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.
 ?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.
                  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
                         (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"))
     command))
 
 (defun cperl-lazy-install ())		; Avoid a warning
+(defun cperl-lazy-unstall ())		; Avoid a warning
 
 (if (fboundp 'run-with-idle-timer)
     (progn
 	"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)
 	      (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)