Emacs CPerl update for 5.004_04

private-msgid: 199710140835.EAA26825@monk.mps.ohio-state.edu

1 files changed, 442 insertions, 169 deletions

diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el
index 017a7a2f61..b00d77a115 100644
--- a/emacs/cperl-mode.el
+++ b/emacs/cperl-mode.el
@@ -32,7 +32,7 @@
 ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
 ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
 
-;; $Id: cperl-mode.el,v 1.33 1997/03/14 06:45:51 ilya Exp ilya $
+;; $Id: cperl-mode.el,v 1.39 1997/10/14 08:28:00 ilya Exp ilya $
 
 ;;; To use this mode put the following into your .emacs file:
 
@@ -53,7 +53,7 @@
 ;;; Additional useful commands to put into your .emacs file:
 
 ;; (setq auto-mode-alist
-;;       (append '(("\\.[pP][Llm]$" . perl-mode))  auto-mode-alist ))
+;;      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
 ;; (setq interpreter-mode-alist (append interpreter-mode-alist
 ;; 				        '(("miniperl" . perl-mode))))
 
@@ -399,7 +399,7 @@
 ;;;; `cperl-use-syntax-table-text-property'.
 
 ;;;; After 1.32.3
-;;;  We scan for s{}[] as well.
+;;;  We scan for s{}[] as well (in simplest situations).
 ;;;  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-\\).
@@ -411,6 +411,58 @@
 ;;; Generation of Class Hierarchy was broken due to a bug in `x-popup-menu'
 ;;;  in 19.34.
 
+;;;; After 1.33:
+;;; my,local highlight vars after {} too.
+;;; TAGS could not be created before imenu was loaded.
+;;; `cperl-indent-left-aligned-comments' created.
+;;; Logic of `cperl-indent-exp' changed a little bit, should be more
+;;;  robust w.r.t. multiline strings.
+;;; Recognition of blah'foo takes into account strings.
+;;; Added '.al' to the list of Perl extensions.
+;;; Class hierarchy is "mostly" sorted (need to rethink algorthm
+;;;  of pruning one-root-branch subtrees to get yet better sorting.)
+;;; Regeneration of TAGS was busted.
+;;; Can use `syntax-table' property when generating TAGS
+;;;  (governed by  `cperl-use-syntax-table-text-property-for-tags').
+
+;;;; After 1.35:
+;;; Can process several =pod/=cut sections one after another.
+;;; Knows of `extproc' when under `emx', indents with `__END__' and `__DATA__'.
+;;; `cperl-under-as-char' implemented (XEmacs people like broken behaviour).
+;;; Beautifier for regexps fixed.
+;;; `cperl-beautify-level', `cperl-contract-level' coded
+;;;
+;;;; Emacs's 20.2 problems:
+;;; `imenu.el' has bugs, `imenu-add-to-menubar' does not work.
+;;; Couple of others problems with 20.2 were reported, my ability to check/fix
+;;; them is very reduced now.
+
+;;;; After 1.36:
+;;;  'C-M-|' in XEmacs fixed
+
+;;;; After 1.37:
+;;;  &&s was not recognized as start of regular expression;
+;;;  Will "preprocess" the contents of //e part of s///e too;
+;;;  What to do with s# blah # foo #e ?
+;;;  Should handle s;blah;foo;; better.
+;;;  Now the only known problems with regular expression recognition:
+;;;;;;;  s<foo>/bar/	- different delimiters (end ignored)
+;;;;;;;  s/foo/\\bar/	- backslash at start of subst (made into one chunk)
+;;;;;;;  s/foo//	- empty subst (made into one chunk + '/')
+;;;;;;;  s/foo/(bar)/	- start-group at start of subst (internal group will not match backwards)
+
+;;;; After 1.38:
+;;;  We highlight closing / of s/blah/foo/e;
+;;;  This handles s# blah # foo #e too;
+;;;  s//blah/, s///, s/blah// works again, and s#blah## too, the algorithm
+;;;   is much simpler now;
+;;;  Next round of changes: s\\\ works, s<blah>/foo/, 
+;;;   comments between the first and the second part allowed
+;;;  Another problem discovered:
+;;;;;;;  s[foo] <blah>e	- e part delimited by different <> (will not match)
+;;;  `cperl-find-pods-heres' somehow maybe called when string-face is undefined
+;;;   - put a stupid workaround for 20.1
+
 (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
 
 (defvar cperl-extra-newline-before-brace nil
@@ -474,7 +526,8 @@ Can be overwritten by `cperl-hairy' if nil.")
 Can be overwritten by `cperl-hairy' if nil.")
 
 (defvar cperl-electric-parens-string "({[]})<"
-  "*String of parentheses that should be electric in CPerl.")
+  "*String of parentheses that should be electric in CPerl.
+Closing ones are electric only if the region is highlighted.")
 
 (defvar cperl-electric-parens nil
   "*Non-nil (and non-null) means parentheses should be electric in CPerl.
@@ -488,10 +541,6 @@ Can be overwritten by `cperl-hairy' if nil.")
   "*Not-nil means that electric parens look for active mark.
 Default is yes if there is visual feedback on mark.")
 
-(defvar cperl-electric-parens-mark (and window-system transient-mark-mode)
-  "*Not-nil means that electric parens look for active mark.
-Default is yes if there is visual feedback on mark.")
-
 (defvar cperl-electric-linefeed nil
   "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy.
 In any case these two mean plain and hairy linefeeds together.
@@ -551,11 +600,14 @@ May require patched `imenu' and `imenu-go'.")
 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
+  (boundp 'parse-sexp-lookup-properties)
   "*Non-nil means CPerl sets up and uses `syntax-table' text property.")
 
-(defvar cperl-scan-files-regexp "\\.\\([Pp][Llm]\\|xs\\)$"
+(defvar cperl-use-syntax-table-text-property-for-tags 
+  cperl-use-syntax-table-text-property
+  "*Non-nil means: set up and use `syntax-table' text property generating TAGS.")
+
+(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\\)$"
@@ -565,6 +617,13 @@ Older version of this page was called `perl5', newer `perl'.")
   "*indentation used when beautifying regexps.
 If `nil', the value of `cperl-indent-level' will be used.")
 
+(defvar cperl-indent-left-aligned-comments t
+  "*Non-nil means that the comment starting in leftmost column should indent.")
+
+(defvar cperl-under-as-char t
+  "*Non-nil means that the _ (underline) should be treated as word char.")
+
+
 
 
 ;;; Short extra-docs.
@@ -798,11 +857,14 @@ progress indicator for indentation (with `imenu' loaded).
   (put-text-property (max (point-min) (1- from))
 		     to cperl-do-not-fontify t))
 
+(defvar cperl-mode-hook nil
+  "Hook run by `cperl-mode'.")
+
 
 ;;; Probably it is too late to set these guys already, but it can help later:
 
 (setq auto-mode-alist
-      (append '(("\\.[pP][Llm]$" . perl-mode))  auto-mode-alist ))
+      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
 (and (boundp 'interpreter-mode-alist)
      (setq interpreter-mode-alist (append interpreter-mode-alist
 					  '(("miniperl" . perl-mode)))))
@@ -847,7 +909,8 @@ progress indicator for indentation (with `imenu' loaded).
   (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 [?\C-\M-\|] 'cperl-lineup
+		    [(control meta |)])
   ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
   ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
   (cperl-define-key "\177" 'cperl-electric-backspace)
@@ -883,6 +946,7 @@ progress indicator for indentation (with `imenu' loaded).
      'indent-for-comment 'cperl-indent-for-comment
      cperl-mode-map global-map)))
 
+(defvar cperl-menu)
 (condition-case nil
     (progn
       (require 'easymenu)
@@ -897,6 +961,10 @@ progress indicator for indentation (with `imenu' loaded).
 	   ["Line up a construction" cperl-lineup (cperl-use-region-p)]
 	   ["Beautify a regexp" cperl-beautify-regexp
 	    cperl-use-syntax-table-text-property]
+	   ["Beautify a group in regexp" cperl-beautify-level
+	    cperl-use-syntax-table-text-property]
+	   ["Contract a group in regexp" cperl-contract-level
+	    cperl-use-syntax-table-text-property]
 	   "----"
 	   ["Indent region" cperl-indent-region (cperl-use-region-p)]
 	   ["Comment region" cperl-comment-region (cperl-use-region-p)]
@@ -936,7 +1004,7 @@ progress indicator for indentation (with `imenu' loaded).
 	      (cperl-write-tags nil t t t) t]
 	     ["Add tags for Perl files in (sub)directories"
 	      (cperl-write-tags nil nil t t) t])
-	    ["Recalculate PODs and HEREs" cperl-find-pods-heres t]
+	    ["Recalculate \"hard\" constructions" cperl-find-pods-heres t]
 	    ["Define word at point" imenu-go-find-at-position 
 	     (fboundp 'imenu-go-find-at-position)]
 	    ["Help on function" cperl-info-on-command t]
@@ -992,7 +1060,8 @@ The expansion is entirely correct because it uses the C preprocessor."
   (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
   (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
   (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
-  (modify-syntax-entry ?_ "w" cperl-mode-syntax-table)
+  (if cperl-under-as-char
+      (modify-syntax-entry ?_ "w" 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))
@@ -1014,6 +1083,9 @@ The expansion is entirely correct because it uses the C preprocessor."
 ;; provide an alias for working with emacs 19.  the perl-mode that comes
 ;; with it is really bad, and this lets us seamlessly replace it.
 (fset 'perl-mode 'cperl-mode)
+(defvar cperl-faces-init)
+;; Fix for msb.el
+(defvar cperl-msb-fixed nil)
 (defun cperl-mode ()
   "Major mode for editing Perl code.
 Expression and list commands understand all C brackets.
@@ -1229,7 +1301,8 @@ with no args."
   (if cperl-use-syntax-table-text-property
       (progn
 	(make-variable-buffer-local 'parse-sexp-lookup-properties)
-	(setq parse-sexp-lookup-properties t)))
+	;; Do not introduce variable if not needed, we check it!
+	(set 'parse-sexp-lookup-properties t)))
   (or (fboundp 'cperl-old-auto-fill-mode)
       (progn
 	(fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
@@ -1266,8 +1339,6 @@ with no args."
 				nil nil
 				'(gud-perldb-history . 1))))
 
-;; Fix for msb.el
-(defvar cperl-msb-fixed nil)
 
 (defun cperl-msb-fix ()
   ;; Adds perl files to msb menu, supposes that msb is already loaded
@@ -1881,7 +1952,9 @@ Returns nil if line starts inside a string, t if in a comment."
 	       '(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!")))
+	      (error "Spaces before pod section!"))
+	 (and (not cperl-indent-left-aligned-comments)
+	      (looking-at "^#")))
 	nil
      (beginning-of-line)
      (let ((indent-point (point))
@@ -2384,20 +2457,118 @@ Returns true if comment is found."
 			       'syntax-table cperl-string-syntax-table))
 	(cperl-protect-defun-start bb e))))
 
+(defun cperl-forward-re (is-2arg set-st st-l err-l argument
+				 &optional ostart oend)
+  ;; Unfinished
+  ;; Works *before* syntax recognition is done
+  ;; May modify syntax-type text property if the situation is too hard
+  (let (b starter ender st i i2)
+    (skip-chars-forward " \t")
+    ;; ender means matching-char matcher.
+    (setq b (point) 
+	  starter (char-after b)
+	  ;; ender:
+	  ender (cdr (assoc starter '(( ?\( . ?\) )
+				      ( ?\[ . ?\] )
+				      ( ?\{ . ?\} )
+				      ( ?\< . ?\> )
+				      ))))
+    ;; What if starter == ?\\  ????
+    (if set-st
+	(if (car st-l)
+	    (setq st (car st-l))
+	  (setcar st-l (make-syntax-table))
+	  (setq i 0 st (car st-l))
+	  (while (< i 256)
+	    (modify-syntax-entry i "." st)
+	    (setq i (1+ i)))
+	  (modify-syntax-entry ?\\ "\\" st)))
+    (setq set-st t)
+    ;; Whether we have an intermediate point
+    (setq i nil)
+    ;; Prepare the syntax table:
+    (and set-st
+	 (if (not ender)		; m/blah/, s/x//, s/x/y/
+	     (modify-syntax-entry starter "$" st)
+	   (modify-syntax-entry starter (concat "(" (list ender)) st)
+	   (modify-syntax-entry ender  (concat ")" (list starter)) st)))
+    (condition-case bb
+	(progn
+	  (if (and (eq starter (char-after (cperl-1+ b)))
+		   (not ender))
+	      ;; $ has TeXish matching rules, so $$ equiv $...
+	      (forward-char 2)
+	    (set-syntax-table st)
+	    (forward-sexp 1)
+	    (set-syntax-table cperl-mode-syntax-table)
+	    ;; Now the problem is with m;blah;;
+	    (and (not ender)
+		 (eq (preceding-char)
+		     (char-after (- (point) 2)))
+		 (save-excursion
+		   (forward-char -2)
+		   (= 0 (% (skip-chars-backward "\\\\") 2)))
+		 (forward-char -1)))
+	  (and is-2arg			; Have trailing part
+	       (not ender)
+	       (eq (following-char) starter) ; Empty trailing part
+	       (if (eq (char-syntax (following-char)) ?.)
+		   (setq is-2arg nil)	; Ignore the tail
+		 ;; Make trailing letter into punctuation
+		 (setq is-2arg nil)	; Ignore the tail
+		 (put-text-property (point) (1+ (point))
+				    'syntax-table cperl-st-punct)
+		 (put-text-property (point) (1+ (point)) 'rear-nonsticky t)))
+	  (if is-2arg			; Not number => have second part
+	      (progn
+		(setq i (point) i2 i)
+		(if ender
+		    (if (eq (char-syntax (following-char)) ?\ )
+			(progn
+			  (while (looking-at "\\s *#")
+			    (beginning-of-line 2))
+			  (skip-chars-forward " \t\n\f")
+			  (setq i2 (point))))
+		  (forward-char -1))
+		(modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
+		(if ender (modify-syntax-entry ender "." st))		
+		(setq set-st nil)
+		(setq 
+		 ender
+		 (cperl-forward-re nil t st-l err-l argument starter ender)
+		 ender (nth 2 ender)))))
+      (error (goto-char (point-max))
+	     (message
+	      "End of `%s%s%c ... %c' string not found: %s"
+	      argument
+	      (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
+	      starter (or ender starter) bb)
+	     (or (car err-l) (setcar err-l b))))
+    (if set-st
+	(progn
+	  (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
+	  (if ender (modify-syntax-entry ender "." st))))
+    (list i i2 ender starter)))
+
 (defun cperl-find-pods-heres (&optional min max)
-  "Scans the buffer for POD sections and here-documents.
+  "Scans the buffer for hard-to-parse Perl constructions.
 If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify 
 the sections using `cperl-pod-head-face', `cperl-pod-face', 
 `cperl-here-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 st i c
+  (let (face head-face here-face b e bb tag qtag b1 e1 argument i c tail state 
 	     (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
+	     (state-point (point-min)) 
+	     (st-l '(nil)) (err-l '(nil)) i2
+	     ;; Somehow font-lock may be not loaded yet...
+	     (font-lock-string-face (if (boundp 'font-lock-string-face)
+					font-lock-string-face
+				      'font-lock-string-face))
 	     (search
 	      (concat
 	       "\\(\\`\n?\\|\n\n\\)=" 
@@ -2434,12 +2605,16 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		    "\\$\\(['{]\\)"
 		    "\\|"
 		    ;; 1+6+2+1+1+2+1=14 extra () before this:
-		    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
+		    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"
+		    ;; 1+6+2+1+1+2+1+1=15 extra () before this:
+		    "\\|"
+		    "__\\(END\\|DATA\\)__"  ; Commented - does not help with indent...
+		    )
 		 ""))))
     (unwind-protect
 	(progn
 	  (save-excursion
-	    (message "Scanning for pods, formats and here-docs...")
+	    (message "Scanning for \"hard\" Perl constructions...")
 	    (if cperl-pod-here-fontify
 		;; We had evals here, do not know why...
 		(setq face cperl-pod-face
@@ -2449,6 +2624,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 				    '(syntax-type t in-pod t syntax-table t))
 	    ;; Need to remove face as well...
 	    (goto-char min)
+	    (if (and (eq system-type 'emx)
+		     (looking-at "extproc[ \t]")) ; Analogue of #!
+		(cperl-commentify min 
+				  (save-excursion (end-of-line) (point))
+				  nil))
 	    (while (re-search-forward search max t)
 	      (cond 
 	       ((match-beginning 1)	; POD section
@@ -2456,14 +2636,14 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		(if (looking-at "\n*cut\\>")
 		    (progn
 		      (message "=cut is not preceded by a pod section")
-		      (or err (setq err (point))))
+		      (or (car err-l) (setcar err-l (point))))
 		  (beginning-of-line)
 		
 		  (setq b (point) bb b)
 		  (or (re-search-forward "\n\n=cut\\>" max 'toend)
 		      (progn
 			(message "Cannot find the end of a pod section")
-			(or err (setq err b))))
+			(or (car err-l) (setcar err-l b))))
 		  (beginning-of-line 2)	; An empty line after =cut is not POD!
 		  (setq e (point))
 		  (put-text-property b e 'in-pod t)
@@ -2499,7 +2679,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 				(match-beginning 1) (match-end 1)
 				'face head-face))))
 		  (cperl-commentify bb e nil)
-		  (goto-char e)))
+		  (goto-char e)
+		  (or (eq e (point-max))
+		      (forward-char -1)))) ; Prepare for immediate pod start.
 	       ;; Here document
 	       ;; We do only one here-per-line
 	       ;; 1 () ahead
@@ -2548,7 +2730,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			 (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))))))
+			   (or (car err-l) (setcar err-l b))))))
 	       ;; format
 	       ((match-beginning 8)
 		;; 1+6=7 extra () before this:
@@ -2587,7 +2769,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      (cperl-commentify (point) (+ (point) 2) nil)
 		      (cperl-put-do-not-fontify (point) (+ (point) 2)))
 		  (message "End of format `%s' not found." name)
-		  (or err (setq err b)))
+		  (or (car err-l) (setcar err-l b)))
 		(forward-line)
 		(put-text-property b (point) 'syntax-type 'format)
 ;;;	       (cond ((re-search-forward (concat "^[.;]$") max 'toend)
@@ -2604,23 +2786,29 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 	       ;; Regexp:
 	       ((or (match-beginning 10) (match-beginning 11))
 		;; 1+6+2=9 extra () before this:
-		;; "\\<\\(qx?\\|[my]\\)\\>"
+		;; "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>"
+		;; "\\|"
+		;; "\\([?/]\\)"	; /blah/ or ?blah?
 		(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))))
+		      bb (char-after (1- (match-beginning b1)))	; tmp holder
+		      bb (and		; user variables/whatever
+			  (match-beginning 10)
+			  (or
+			   (memq bb '(?\$ ?\@ ?\% ?\*))
+			   (and (eq bb ?-) (eq c ?s)) ; -s file test
+			   (and (eq bb ?\&) ; &&m/blah/
+				(not (eq (char-after 
+					  (- (match-beginning b1) 2))
+					 ?\&))))))
 		(or bb
 		    (if (eq b1 11)	; bare /blah/ or ?blah?
 			(setq argument ""
-			     bb 
+			     bb		; Not a regexp?
 			     (progn
 			       (goto-char (match-beginning b1))
 			       (cperl-backward-to-noncomment (point-min))
@@ -2635,7 +2823,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 					     (progn
 					       (forward-sexp -1)
 					       (looking-at 
-						"\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\)\\>")))
+						"\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))
 					(and (eq (preceding-char) ?.)
 					     (eq (char-after (- (point) 2)) ?.))
 					(bobp))))
@@ -2647,83 +2835,32 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		(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)
+		  ;; qtag means two-arg matcher, may be reset to
+		  ;;   2 or 3 later if some special quoting is needed.
+		  ;; e1 means matching-char matcher.
+		  (setq b (point)
+			i (cperl-forward-re 
+			   (string-match "^\\([sy]\\|tr\\)$" argument)
+			   t st-l err-l argument)
+			i2 (nth 1 i)	; start of the second part
+			e1 (nth 2 i)	; ender, true if matching second part
+			i (car i)	; intermediate point
+			tail (if (and i (not e1)) (1- (point))))
+		  ;; Commenting \\ is dangerous, what about ( ?
+		  (and i tail
+		       (eq (char-after i) ?\\)
+		       (setq i nil tail nil))
 		  (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 (looking-at "\\sw*e") ; s///e
+			(cperl-find-pods-heres i2 (1- (point)))
+		      (cperl-commentify i2 (point) t)
+		      (setq tail nil)))
 		  (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))))
+		      (progn
+			(forward-word 1) ; skip modifiers s///s
+			(if tail (cperl-commentify tail (point) t))))))
 	       ((match-beginning 13)	; sub with prototypes
 		(setq b (match-beginning 0))
 		(if (memq (char-after (1- b))
@@ -2737,6 +2874,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		    ;; Mark as string
 		    (cperl-commentify (match-beginning 13) (match-end 13) t))
 		  (goto-char (match-end 0))))
+	       ;; 1+6+2+1+1+2=13 extra () before this:
+	       ;;    "\\$\\(['{]\\)"
 	       ((and (match-beginning 14)
 		 (eq (preceding-char) ?\')) ; $'
 		(setq b (1- (point))
@@ -2748,13 +2887,38 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      (put-text-property (1- b) b 'syntax-table cperl-st-punct)
 		      (put-text-property (1- b) b 'rear-nonsticky t)))
 		(goto-char (1+ b)))
+	       ;; 1+6+2+1+1+2=13 extra () before this:
+	       ;;    "\\$\\(['{]\\)"
 	       ((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))))
+	       ;; 1+6+2+1+1+2+1=14 extra () before this:
+	       ;;    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
+	       ((match-beginning 15)	; old $abc'efg syntax
+		(setq bb (match-end 0)
+		      b (match-beginning 0)
+		      state (parse-partial-sexp 
+			     state-point b nil nil state)
+		      state-point b)
+		(if (nth 3 state)	; in string
+		    nil
+		  (put-text-property (1- bb) bb 'syntax-table cperl-st-word))
+		(goto-char bb))
+	       ;; 1+6+2+1+1+2+1+1=15 extra () before this:
+	       ;; "__\\(END\\|DATA\\)__"
+	       (t			; __END__, __DATA__
+		(setq bb (match-end 0)
+		      b (match-beginning 0)
+		      state (parse-partial-sexp 
+			     state-point b nil nil state)
+		      state-point b)
+		(if (or (nth 3 state) (nth 4 state))
+		    nil
+		  ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
+		  (cperl-commentify b bb nil)
+		  )
+		(goto-char bb))))
 ;;;	    (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
 ;;;	      (if (looking-at "\n*cut\\>")
 ;;;		  (progn
@@ -2850,8 +3014,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 ;;;		     (cperl-put-do-not-fontify b (match-beginning 0)))
 ;;;		    (t (message "End of format `%s' not found." name))))
 )
-	  (if err (goto-char err)
-	    (message "Scan for pods, formats and here-docs completed.")))
+	  (if (car err-l) (goto-char (car err-l))
+	    (message "Scan for \"hard\" Perl constructions completed.")))
       (and (buffer-modified-p)
 	   (not modified)
 	   (set-buffer-modified-p nil))
@@ -2864,9 +3028,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
       (skip-chars-backward " \t\n\f" lim)
       (setq p (point))
       (beginning-of-line)
-      (if (looking-at "^[ \t]*\\(#\\|$\\)") nil	; Only comment, skip
+      (if (or (looking-at "^[ \t]*\\(#\\|$\\)")
+	      (progn (cperl-to-comment-or-eol) (bolp)))
+	  nil	; Only comment, skip
 	;; Else
-	(cperl-to-comment-or-eol) 
 	(skip-chars-backward " \t")
 	(if (< p (point)) (goto-char p))
 	(setq stop t)))))
@@ -2931,8 +3096,8 @@ or looks like continuation of the comment on the previous line."
   (save-excursion
     (let ((tmp-end (progn (end-of-line) (point))) top done)
       (save-excursion
+	(beginning-of-line)
 	(while (null done)
-	  (beginning-of-line)
 	  (setq top (point))
 	  (while (= (nth 0 (parse-partial-sexp (point) tmp-end
 					       -1)) -1)
@@ -3147,6 +3312,7 @@ indentation and initial hashes. Behaves usually outside of comment."
 
 (defun imenu-example--create-perl-index (&optional regexp)
   (require 'cl)
+  (require 'imenu)			; May be called from TAGS creator
   (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) 
 	(index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
 	(index-meth-alist '()) meth
@@ -3162,6 +3328,12 @@ indentation and initial hashes. Behaves usually outside of comment."
 	(imenu-progress-message prev-pos)
 	;;(backward-up-list 1)
 	(cond
+	 ((and				; Skip some noise if building tags
+	   (match-beginning 2)		; package or sub
+	   (eq (char-after (match-beginning 2)) ?p) ; package
+	   (not (save-match-data
+		  (looking-at "[ \t\n]*;"))))  ; Plain text word 'package'
+	  nil)
 	 ((and
 	   (match-beginning 2)		; package or sub
 	   ;; Skip if quoted (will not skip multi-line ''-comments :-():
@@ -3473,12 +3645,12 @@ indentation and initial hashes. Behaves usually outside of comment."
 				   (2 '(restart 2 nil) nil t))) 
 			nil t)))	; local variables, multiple
 		  (font-lock-anchored
-		   '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
+		   '("^[ \t{}]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
 		     (3 font-lock-variable-name-face)
 		     ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)"
 		      nil nil
 		      (1 font-lock-variable-name-face))))
-		  (t '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
+		  (t '("^[ \t{}]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
 		       3 font-lock-variable-name-face)))
 	    '("\\<for\\(each\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
 	      2 font-lock-variable-name-face)))
@@ -4037,7 +4209,7 @@ in subdirectories too."
      ((eq all 'recursive)
       ;;(error "Not implemented: recursive")
       (setq args (append (list "-e" 
-			       "sub wanted {push @ARGV, $File::Find::name if /\\.[Pp][Llm]$/}
+			       "sub wanted {push @ARGV, $File::Find::name if /\\.[pP][Llm]$/}
 				use File::Find;
 				find(\\&wanted, '.');
 				exec @ARGV;" 
@@ -4086,7 +4258,12 @@ in subdirectories too."
   (set-buffer (get-buffer-create cperl-tmp-buffer))
   (set-syntax-table cperl-mode-syntax-table)
   (buffer-disable-undo)
-  (auto-fill-mode 0))
+  (auto-fill-mode 0)
+  (if cperl-use-syntax-table-text-property-for-tags
+      (progn
+	(make-variable-buffer-local 'parse-sexp-lookup-properties)
+	;; Do not introduce variable if not needed, we check it!
+	(set 'parse-sexp-lookup-properties t))))
 
 (defun cperl-xsub-scan ()
   (require 'cl)
@@ -4136,13 +4313,16 @@ in subdirectories too."
     index-alist))
 
 (defun cperl-find-tags (file xs)
-  (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret)
+  (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret
+	    (cperl-pod-here-fontify nil))
     (save-excursion
       (if b (set-buffer b)
 	  (cperl-setup-tmp-buf))
       (erase-buffer)
       (setq file (car (insert-file-contents file)))
       (message "Scanning file %s..." file)
+      (if cperl-use-syntax-table-text-property-for-tags
+	  (cperl-find-pods-heres))
       (if xs
 	  (setq lst (cperl-xsub-scan))
 	(setq ind (imenu-example--create-perl-index))
@@ -4242,10 +4422,11 @@ in subdirectories too."
 		   (progn
 		     (search-backward "\f\n")
 		     (delete-region (point)
-				    (progn 
+				    (save-excursion
 				      (forward-char 1)
-				      (search-forward "\f\n" nil 'toend)
-				      (point))))
+				      (if (search-forward "\f\n" nil 'toend)
+				       (- (point) 2)
+				       (point-max)))))
 		 (goto-char (point-max)))))
 	(insert (cperl-find-tags file xs))))
       (if inbuffer nil		; Delegate to the caller
@@ -4362,7 +4543,7 @@ One may build such TAGS files from CPerl mode menu."
   (if (eq update -999) (cperl-tags-hier-init t)))
 
 (defun cperl-tags-treeify (to level)
-  ;; cadr of to is read-write. On start it is a cons
+  ;; cadr of `to' is read-write. On start it is a cons
   (let* ((regexp (concat "^\\(" (mapconcat 
 				 'identity
 				 (make-list level "[_a-zA-Z0-9]+")
@@ -4403,23 +4584,33 @@ One may build such TAGS files from CPerl mode menu."
 	(mapcar (function (lambda (elt)
 			  (cperl-tags-treeify elt (1+ level))))
 		(cdr to)))
+    ;;Now clean up leaders with one child only
+    (mapcar (function (lambda (elt)
+			(if (not (and (listp (cdr elt)) 
+				      (eq (length elt) 2))) nil
+			    (setcar elt (car (nth 1 elt)))
+			    (setcdr elt (cdr (nth 1 elt))))))
+	    (cdr to))
+    ;; Sort the roots of subtrees
+    (if (default-value 'imenu-sort-function)
+	(setcdr to
+		(sort (cdr to) (default-value 'imenu-sort-function))))
     ;; Now add back functions removed from display
     (mapcar (function (lambda (elt)
 			(setcdr to (cons elt (cdr to)))))
-	    root-functions)
+	    (if (default-value 'imenu-sort-function)
+		(nreverse
+		 (sort root-functions (default-value 'imenu-sort-function)))
+	      root-functions))
     ;; Now add back packages removed from display
     (mapcar (function (lambda (elt)
 			(setcdr to (cons (cons (concat "package " (car elt)) 
 					       (cdr elt)) 
 					 (cdr to)))))
-	    root-packages)
-    ;;Now clean up leaders with one child only
-    (mapcar (function (lambda (elt)
-			(if (not (and (listp (cdr elt)) 
-				      (eq (length elt) 2))) nil
-			    (setcar elt (car (nth 1 elt)))
-			    (setcdr elt (cdr (nth 1 elt))))))
-	    (cdr to))
+	    (if (default-value 'imenu-sort-function)
+		(nreverse 
+		 (sort root-packages (default-value 'imenu-sort-function)))
+	      root-packages))
     ))
 
 ;;;(x-popup-menu t
@@ -5136,7 +5327,7 @@ prototype \&SUB	Returns prototype of the function given a reference.
 (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)
+  (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code)
     (if (not embed)
 	(goto-char (1+ b))
       (goto-char b)
@@ -5150,7 +5341,7 @@ prototype \&SUB	Returns prototype of the function given a reference.
 	     (forward-char 2))
 	    (t
 	     (forward-char 1))))
-    (setq c (1- (current-column))
+    (setq c (if embed (current-indentation) (1- (current-column)))
 	  c1 (+ c (or cperl-regexp-indent-step cperl-indent-level)))
     (or (looking-at "[ \t]*[\n#]")
 	(progn
@@ -5175,18 +5366,18 @@ prototype \&SUB	Returns prototype of the function given a reference.
       (while (and
 	      inline
 	      (looking-at 
-	       (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1
-		       "\\|"
+	       (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1 word
+		       "\\|"		; Embedded variable
 		       "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3
-		       "\\|"
+		       "\\|"		; $ ^
 		       "[$^]"
-		       "\\|"
+		       "\\|"		; simple-code simple-code*?
 		       "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5
-		       "\\|"
+		       "\\|"		; Class
 		       "\\(\\[\\)"	; 6
-		       "\\|"
+		       "\\|"		; Grouping
 		       "\\((\\(\\?\\)?\\)" ; 7 8
-		       "\\|"
+		       "\\|"		; |
 		       "\\(|\\)"	; 9
 		       )))
 	(goto-char (match-end 0))
@@ -5223,7 +5414,17 @@ prototype \&SUB	Returns prototype of the function given a reference.
 	       ;;		     (error "()-group not terminated")))
 	       (set-marker m (1- (point)))
 	       (set-marker m1 (point))
-	       (cperl-beautify-regexp-piece tmp m t)
+	       (cond
+		((not (match-beginning 8))
+		 (cperl-beautify-regexp-piece tmp m t))
+		((eq (char-after (+ 2 tmp)) ?\{) ; Code
+		 t)
+		((eq (char-after (+ 2 tmp)) ?\() ; Conditional
+		 (goto-char (+ 2 tmp))
+		 (forward-sexp 1)
+		 (cperl-beautify-regexp-piece (point) m t))
+		(t
+		 (cperl-beautify-regexp-piece tmp m t)))
 	       (goto-char m1)
 	       (cond ((looking-at "[*+?]\\??")
 		      (goto-char (match-end 0)))
@@ -5234,7 +5435,9 @@ prototype \&SUB	Returns prototype of the function given a reference.
 	       (skip-chars-forward " \t")
 	       (setq spaces nil)
 	       (if (looking-at "[#\n]")
-		   (beginning-of-line 2)
+		   (progn
+		     (or (eolp) (indent-for-comment))
+		     (beginning-of-line 2))
 		 (insert "\n"))
 	       (end-of-line)
 	       (setq inline nil))
@@ -5262,39 +5465,109 @@ prototype \&SUB	Returns prototype of the function given a reference.
 	    (insert " "))
 	(skip-chars-forward " \t"))
 	(or (looking-at "[#\n]")
-	    (error "unknown code in a regexp"))
+	    (error "unknown code \"%s\" in a regexp" (buffer-substring (point)
+									(1+ (point)))))
 	(and inline (end-of-line 2)))
+    ;; Special-case the last line of group
+    (if (and (>= (point) (marker-position e))
+	     (/= (current-indentation) c))
+	(progn
+	 (beginning-of-line)
+	 (setq s (point))
+	 (skip-chars-forward " \t")
+	 (delete-region s (point))
+	 (indent-to-column c)))
   ))
 
+(defun cperl-make-regexp-x ()
+  (save-excursion
+    (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)))
+      b)))
+
 (defun cperl-beautify-regexp ()
-  "do it. (Experimental, may change semantics, recheck afterwards.)
+  "do it. (Experimental, may change semantics, recheck the result.)
 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
+  (cperl-make-regexp-x)
   (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)
+  (let ((b (point)) (e (make-marker)))
     (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)))
 
+(defun cperl-contract-level ()
+  "Find an enclosing group in regexp and contract it. (Experimental, may change semantics, recheck the result.) Unfinished.
+We suppose that the regexp is scanned already."
+  (interactive)
+  (let ((bb (cperl-make-regexp-x)) done)
+    (while (not done)
+      (or (eq (following-char) ?\()
+	  (search-backward "(" (1+ bb) t)
+	  (error "Cannot find `(' which starts a group"))
+      (setq done
+	    (save-excursion
+	      (skip-chars-backward "\\")
+	      (looking-at "\\(\\\\\\\\\\)*(")))
+      (or done (forward-char -1)))
+    (let ((b (point)) (e (make-marker)) s c)
+      (forward-sexp 1)
+      (set-marker e (1- (point)))
+      (goto-char b)
+      (while (re-search-forward "\\(#\\)\\|\n" e t)
+	(cond 
+	 ((match-beginning 1)		; #-comment
+	  (or c (setq c (current-indentation)))
+	  (beginning-of-line 2)		; Skip
+	  (setq s (point))
+	  (skip-chars-forward " \t")
+	  (delete-region s (point))
+	  (indent-to-column c))
+	 (t
+	  (delete-char -1)
+	  (just-one-space)))))))
+
+(defun cperl-beautify-level ()
+  "Find an enclosing group in regexp and beautify it. (Experimental, may change semantics, recheck the result.)
+We suppose that the regexp is scanned already."
+  (interactive)
+  (let ((bb (cperl-make-regexp-x)) done)
+    (while (not done)
+      (or (eq (following-char) ?\()
+	  (search-backward "(" (1+ bb) t)
+	  (error "Cannot find `(' which starts a group"))
+      (setq done
+	    (save-excursion
+	      (skip-chars-backward "\\")
+	      (looking-at "\\(\\\\\\\\\\)*(")))
+      (or done (forward-char -1)))
+    (let ((b (point)) (e (make-marker)))
+      (forward-sexp 1)
+      (set-marker e (1- (point)))
+      (cperl-beautify-regexp-piece b e nil))))
+
 (if (fboundp 'run-with-idle-timer)
     (progn
       (defvar cperl-help-shown nil