cperl-mode.el v4.19

p4raw-id: //depot/perl@3830

1 files changed, 583 insertions, 204 deletions

diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el
index 3d7be098c0..371d420321 100644
--- a/emacs/cperl-mode.el
+++ b/emacs/cperl-mode.el
@@ -46,9 +46,9 @@
 
 ;;; Commentary:
 
-;; $Id: cperl-mode.el 4.5 1998/07/28 08:55:41 vera Exp vera $
+;; $Id: cperl-mode.el,v 4.19 1998/12/10 03:31:23 ilya Exp ilya $
 
-;;; Before (future?) RMS Emacs 20.3: To use this mode put the following into
+;;; Before RMS Emacs 20.3: To use this mode put the following into
 ;;; your .emacs file:
 
 ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
@@ -66,7 +66,7 @@
 ;;; `cperl-non-problems', `cperl-praise', `cperl-speed'.            <<<<<<
 
 ;;; Additional useful commands to put into your .emacs file (before
-;;; (future?) RMS Emacs 20.3):
+;;; RMS Emacs 20.3):
 
 ;; (setq auto-mode-alist
 ;;      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
@@ -501,12 +501,12 @@
 ;;;  Debugging code in `cperl-electric-keywords' was leaking a message;
 
 ;;;; After 1.41:
-;;;  RMS changes for (future?) 20.3 merged
+;;;  RMS changes for 20.3 merged
 
 ;;;; 2.0.1.0: RMS mode (has 3 misprints)
 
 ;;;; After 2.0:
-;;;  RMS whitespace changes for (future?) 20.3 merged
+;;;  RMS whitespace changes for 20.3 merged
 
 ;;;; After 2.1:
 ;;;  History updated
@@ -800,6 +800,114 @@
 ;;;				`constant-face' was backward.
 ;;;  (`font-lock-other-type-face'): Done via `defface' too.
 
+;;;; After 4.5:
+;;;  (`cperl-init-faces-weak'):	use `cperl-force-face'.
+;;;  (`cperl-after-block-p'):	After END/BEGIN we are a block.
+;;;  (`cperl-mode'):		`font-lock-unfontify-region-function' 
+;;;				was set to a wrong function.
+;;;  (`cperl-comment-indent'):	Commenting __END__ was not working.
+;;;  (`cperl-indent-for-comment'):	Likewise.
+;;;				(Indenting is still misbehaving at toplevel.)
+
+;;;; After 4.5:
+;;;  (`cperl-unwind-to-safe'):	Signature changed, unwinds end too.
+;;;  (`cperl-find-pods-heres'):	mark qq[]-etc sections as syntax-type=string
+;;;  (`cperl-fontify-syntaxically'): Unwinds start and end to go out of 
+;;;				     long strings (not very successful).
+
+;;;   >>>>  CPerl should be usable in write mode too now <<<<
+
+;;;  (`cperl-syntaxify-by-font-lock'): Better default - off in text-mode.
+;;;  (`cperl-tips'): 		Updated docs.
+;;;  (`cperl-problems'):	Updated docs.
+
+;;;; After 4.6:
+;;;  (`cperl-calculate-indent'):	Did not consider `,' as continuation mark for statements.
+;;;  (`cperl-write-tags'):	Correct for XEmacs's `visit-tags-table-buffer'.
+
+;;;; After 4.7:
+;;;  (`cperl-calculate-indent'): Avoid parse-data optimization at toplevel.
+;;;				 Should indent correctly at toplevel too.
+;;;  (`cperl-tags-hier-init'):	Gross hack to pretend we work (are we?).
+;;;  (`cperl-find-pods-heres'):	Was not processing sub protos after a comment ine.
+;;;				Was treating $a++ <= 5 as a glob.
+
+;;;; After 4.8:
+;;;  (toplevel):		require custom unprotected => failure on 19.28.
+;;;  (`cperl-xemacs-p')		defined when compile too
+;;;  (`cperl-tags-hier-init'):	Another try to work around XEmacs problems
+;;;				Better progress messages.
+;;;  (`cperl-find-tags'):	Was writing line/pos in a wrong order, 
+;;;				pos off by 1 and not at beg-of-line.
+;;;  (`cperl-etags-snarf-tag'): New macro
+;;;  (`cperl-etags-goto-tag-location'): New macro
+;;;  (`cperl-write-tags'):	When removing old TAGS info was not 
+;;;				relativizing filename
+
+;;;; After 4.9:
+;;;  (`cperl-version'):		New variable.  New menu entry
+
+;;;; After 4.10:
+;;;  (`cperl-tips'):		Updated.
+;;;  (`cperl-non-problems'):	Updated.
+;;;  random:			References to future 20.3 removed.
+
+;;;; After 4.11:
+;;;  (`perl-font-lock-keywords'): Would not highlight `sub foo($$);'.
+;;;  Docstrings:		Menu was described as `CPerl' instead of `Perl'
+
+;;;; After 4.12:
+;;;  (`cperl-toggle-construct-fix'): Was toggling to t instead of 1.
+;;;  (`cperl-ps-print-init'):	Associate `cperl-array-face', `cperl-hash-face'
+;;;				remove `font-lock-emphasized-face'.
+;;;				remove `font-lock-other-emphasized-face'.
+;;;				remove `font-lock-reference-face'.
+;;;				remove `font-lock-keyword-face'.
+;;;				Use `eval-after-load'.
+;;;  (`cperl-init-faces'):	remove init `font-lock-other-emphasized-face'.
+;;;				remove init `font-lock-emphasized-face'.
+;;;				remove init `font-lock-keyword-face'.
+;;;  (`cperl-tips-faces'):	New variable and an entry into Mini-docs.
+;;;  (`cperl-indent-region'):	Do not indent whitespace lines
+;;;  (`cperl-indent-exp'):	Was not processing else-blocks.
+;;;  (`cperl-calculate-indent'): Remove another parse-data optimization
+;;;				 at toplevel: would indent correctly.
+;;;  (`cperl-get-state'):	NOP line removed.
+
+;;;; After 4.13:
+;;;  (`cperl-ps-print-init'):	Remove not-CPerl-related faces.
+;;;  (`cperl-ps-print'):	New function and menu entry.
+;;;  (`cperl-ps-print-face-properties'):	New configuration variable.
+;;;  (`cperl-invalid-face'):	New configuration variable.
+;;;  (`cperl-nonoverridable-face'):	New face.  Renamed from
+;;;					`font-lock-other-type-face'.
+;;;  (`perl-font-lock-keywords'):	Highlight trailing whitespace
+;;;  (`cperl-contract-levels'):	Documentation corrected.
+;;;  (`cperl-contract-level'):	Likewise.
+
+;;;; After 4.14:
+;;;  (`cperl-ps-print'): `ps-print-face-extension-alist' was not in old Emaxen,
+;;;				same with `ps-extend-face-list'
+;;;  (`cperl-ps-extend-face-list'):	New macro.
+
+;;;; After 4.15:
+;;;  (`cperl-init-faces'):	Interpolate `cperl-invalid-face'.
+;;;  (`cperl-forward-re'):	Emit a meaningful error instead of a cryptic
+;;;				one for uncomplete REx near end-of-buffer.
+;;;  (`cperl-find-pods-heres'):	Tolerate unfinished REx at end-of-buffer.
+
+;;;; After 4.16:
+;;;  (`cperl-find-pods-heres'): `unwind-protect' was left commented.
+
+;;;; After 4.17:
+;;;  (`cperl-invalid-face'):	Change to ''underline.
+
+;;;; After 4.18:
+;;;  (`cperl-find-pods-heres'):	/ and ? after : start a REx.
+;;;  (`cperl-after-expr-p'):	Skip labels when checking
+;;;  (`cperl-calculate-indent'): Correct for labels when calculating 
+;;;					indentation of continuations.
+;;;				Docstring updated.
 ;;; Code:
 
 
@@ -808,6 +916,7 @@
       (condition-case nil
 	  (require 'custom)
 	(error nil))
+      (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
       (or (fboundp 'defgroup)
 	  (defmacro defgroup (name val doc &rest arr)
 	    nil))
@@ -826,6 +935,11 @@
 		  ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col))))
 		  ;; XEmacs 19.11
 		  (t (` (x-valid-color-name-p (, col)))))))
+      (if (fboundp 'ps-extend-face-list)
+	  (defmacro cperl-ps-extend-face-list (arg)
+	    (` (ps-extend-face-list (, arg))))
+	(defmacro cperl-ps-extend-face-list (arg)
+	  (` (error "This version of Emacs has no `ps-extend-face-list'."))))
       (defmacro cperl-is-face (arg)	; Takes quoted arg
 	    (cond ((fboundp 'find-face)
 		   (` (find-face (, arg))))
@@ -846,9 +960,31 @@
 	     (or (cperl-is-face (quote (, arg)))
 		 (cperl-make-face (, arg) (, descr)))
 	     (or (boundp (quote (, arg))) ; We use unquoted variants too
-		 (defconst (, arg) (quote (, arg)) (, descr))))))))
+		 (defconst (, arg) (quote (, arg)) (, descr))))))
+      (if cperl-xemacs-p
+	  (defmacro cperl-etags-snarf-tag (file line)
+	    (` (progn
+		 (beginning-of-line 2)
+		 (list (, file) (, line)))))
+	(defmacro cperl-etags-snarf-tag (file line)
+	  (` (etags-snarf-tag))))
+      (if cperl-xemacs-p
+	  (defmacro cperl-etags-goto-tag-location (elt)
+	    (` ;;(progn
+		 ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0)))
+		 ;; (set-buffer (get-file-buffer (elt (, elt) 0)))
+		 ;; Probably will not work due to some save-excursion???
+		 ;; Or save-file-position?
+		 ;; (message "Did I get to line %s?" (elt (, elt) 1))
+		 (goto-line (string-to-int (elt (, elt) 1)))))
+	    ;;)
+	(defmacro cperl-etags-goto-tag-location (elt)
+	  (` (etags-goto-tag-location (, elt)))))))
+
+(condition-case nil
+    (require 'custom)
+  (error nil))				; Already fixed by eval-when-compile
 
-(require 'custom)
 (defun cperl-choose-color (&rest list)
   (let (answer)
     (while list
@@ -1100,6 +1236,11 @@ Font for POD headers."
   :type 'face
   :group 'cperl-faces)
 
+(defcustom cperl-invalid-face ''underline ; later evaluated by `font-lock'
+  "*The result of evaluation of this expression highlights trailing whitespace."
+  :type 'face
+  :group 'cperl-faces)
+
 (defcustom cperl-pod-here-fontify '(featurep 'font-lock)
   "*Not-nil after evaluation means to highlight pod and here-docs sections."
   :type 'boolean
@@ -1214,7 +1355,8 @@ may be merged to be on the same line when indenting a region."
   :group 'cperl-indentation-details)
 
 (defcustom cperl-syntaxify-by-font-lock 
-  (boundp 'parse-sexp-lookup-properties)
+  (and window-system 
+       (boundp 'parse-sexp-lookup-properties))
   "*Non-nil means that CPerl uses `font-lock's routines for syntaxification.
 Having it TRUE may be not completely debugged yet."
   :type '(choice (const message) boolean)
@@ -1227,6 +1369,25 @@ when syntaxifying a chunk of buffer."
   :type 'boolean
   :group 'cperl-speed)
 
+(defcustom cperl-ps-print-face-properties
+  '((font-lock-keyword-face		nil nil		bold shadow)
+    (font-lock-variable-name-face	nil nil		bold)
+    (font-lock-function-name-face	nil nil		bold italic box)
+    (font-lock-constant-face		nil "LightGray"	bold)
+    (cperl-array-face			nil "LightGray"	bold underline)
+    (cperl-hash-face			nil "LightGray"	bold italic underline)
+    (font-lock-comment-face		nil "LightGray"	italic)
+    (font-lock-string-face		nil nil		italic underline)
+    (cperl-nonoverridable-face		nil nil		italic underline)
+    (font-lock-type-face		nil nil		underline)
+    (underline				nil "LightGray"	strikeout))
+  "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
+  :type '(repeat (cons symbol 
+		       (cons (choice (const nil) string)
+			     (cons (choice (const nil) string)
+				   (repeat symbol)))))
+  :group 'cperl-faces)
+
 (if window-system
     (progn
       (defvar cperl-dark-background 
@@ -1234,7 +1395,7 @@ when syntaxifying a chunk of buffer."
       (defvar cperl-dark-foreground 
 	(cperl-choose-color "orchid1" "orange"))
 
-      (defface font-lock-other-type-face
+      (defface cperl-nonoverridable-face
 	(` ((((class grayscale) (background light))
 	     (:background "Gray90" :italic t :underline t))
 	    (((class grayscale) (background dark))
@@ -1285,6 +1446,13 @@ and/or
 Subdirectory `cperl-mode' may contain yet newer development releases and/or
 patches to related files.
 
+For best results apply to an older Emacs the patches from
+  ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches
+\(this upgrades syntax-parsing abilities of RMS Emaxen v19.34 and 
+v20.2 up to the level of RMS Emacs v20.3 - a must for a good Perl
+mode.)  You will not get much from XEmacs, it's syntax abilities are
+too primitive.
+
 Get support packages choose-color.el (or font-lock-extra.el before
 19.30), imenu-go.el from the same place.  \(Look for other files there
 too... ;-).  Get a patch for imenu.el in 19.29.  Note that for 19.30 and
@@ -1300,20 +1468,25 @@ older version was on
   http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz
 
 If you use imenu-go, run imenu on perl5-info buffer (you can do it
-from CPerl menu).  If many files are related, generate TAGS files from
-Tools/Tags submenu in CPerl menu.
+from Perl menu).  If many files are related, generate TAGS files from
+Tools/Tags submenu in Perl menu.
 
 If some class structure is too complicated, use Tools/Hierarchy-view
-from CPerl menu, or hierarchic view of imenu. The second one uses the
+from Perl menu, or hierarchic view of imenu. The second one uses the
 current buffer only, the first one requires generation of TAGS from
-CPerl/Tools/Tags menu beforehand.
+Perl/Tools/Tags menu beforehand.
+
+Run Perl/Tools/Insert-spaces-if-needed to fix your lazy typing.
+
+Switch auto-help on/off with Perl/Tools/Auto-help.
 
-Run CPerl/Tools/Insert-spaces-if-needed to fix your lazy typing.
+Though with contemporary Emaxen CPerl mode should maintain the correct
+parsing of Perl even when editing, sometimes it may be lost.  Fix this by
 
-Switch auto-help on/off with CPerl/Tools/Auto-help.
+  M-x norm RET
 
-Before reporting (non-)problems look in the problem section on what I
-know about them.")
+Before reporting (non-)problems look in the problem section of online
+micro-docs on what I know about CPerl problems.")
 
 (defvar cperl-problems 'please-ignore-this-line
 "Some faces will not be shown on some versions of Emacs unless you
@@ -1322,13 +1495,14 @@ install choose-color.el, available from
 
 Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs
 20.1.  Most problems below are corrected starting from this version of
-Emacs, and all of them should go with (future) RMS's version 20.3.
+Emacs, and all of them should go with RMS's version 20.3.
+(Or apply patches to Emacs 19.33/34 - see tips.)
 
 Note that even with newer Emacsen interaction of `font-lock' and
 syntaxification is not cleaned up.  You may get slightly different
 colors basing on the order of fontification and syntaxification.  This
 might be corrected by setting `cperl-syntaxify-by-font-lock' to t, but
-the corresponding code is still extremely buggy.
+the corresponding code may still contain some bugs.
 
 Even with older Emacsen CPerl mode tries to corrects some Emacs
 misunderstandings, however, for efficiency reasons the degree of
@@ -1350,9 +1524,10 @@ to insert it as $ {aaa} (legal in perl5, not in perl4).
 Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
 as /($|\\s)/.  Note that such a transposition is not always possible.
 
-The solution is to upgrade your Emacs.  Note that RMS's 20.2 has some
-bugs related to `syntax-table' text properties.  Patches are available
-on the main CPerl download site, and on CPAN.
+The solution is to upgrade your Emacs or patch an older one.  Note
+that RMS's 20.2 has some bugs related to `syntax-table' text
+properties.  Patches are available on the main CPerl download site,
+and on CPAN.
 
 If these bugs cannot be fixed on your machine (say, you have an inferior
 environment and cannot recompile), you may still disable all the fancy stuff
@@ -1360,7 +1535,9 @@ 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 
-older Emacsen.
+older Emacsen.  Here is what you can do if you cannot upgrade, or if
+you want to switch off these capabilities on RMS Emacs 20.2 (+patches) or 20.3
+or better.  Please skip this docs if you run a capable Emacs already.
 
 Most of the time, if you write your own code, you may find an equivalent
 \(and almost as readable) expression (what is discussed below is usually
@@ -1419,8 +1596,11 @@ as far as bugs reports I see are concerned.")
 
 1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl
 mode - but the latter number may have improved too in last years) even 
-without `syntax-table' property; When using this property, it should 
-handle 99.995% of lines correct - or somesuch.
+with old Emaxen which do not support `syntax-table' property.
+
+When using `syntax-table' property for syntax assist hints, it should
+handle 99.995% of lines correct - or somesuch.  It automatically
+updates syntax assist hints when you edit your script.
 
 2) It is generally believed to be \"the most user-friendly Emacs
 package\" whatever it may mean (I doubt that the people who say similar
@@ -1471,6 +1651,7 @@ voice);
 
         n) Highlights (by user-choice) either 3-delimiters constructs
 	   (such as tr/a/b/), or regular expressions and `y/tr'.
+	m) Highlights trailing whitespace.
 
 5) The indentation engine was very smart, but most of tricks may be
 not needed anymore with the support for `syntax-table' property.  Has
@@ -1533,6 +1714,41 @@ B) Speed of editing operations.
     of, say, long POD sections.
 ")
 
+(defvar cperl-tips-faces 'please-ignore-this-line
+  "CPerl mode uses following faces for highlighting:
+
+  cperl-array-face		Array names
+  cperl-hash-face		Hash names
+  font-lock-comment-face	Comments, PODs and whatever is considered
+				syntaxically to be not code
+  font-lock-constant-face	HERE-doc delimiters, labels, delimiters of
+				2-arg operators s/y/tr/ or of RExen,
+  font-lock-function-name-face	Special-cased m// and s//foo/, _ as 
+				a target of a file tests, file tests,
+				subroutine names at the moment of definition
+				(except those conflicting with Perl operators),
+				package names (when recognized), format names
+  font-lock-keyword-face	Control flow switch constructs, declarators
+  cperl-nonoverridable-face	Non-overridable keywords, modifiers of RExen
+  font-lock-string-face		Strings, qw() constructs, RExen, POD sections,
+				literal parts and the terminator of formats
+				and whatever is syntaxically considered
+				as string literals
+  font-lock-type-face		Overridable keywords
+  font-lock-variable-name-face	Variable declarations, indirect array and
+				hash names, POD headers/item names
+  cperl-invalid-face		Trailing whitespace
+
+Note that in several situations the highlighting tries to inform about
+possible confusion, such as different colors for function names in
+declarations depending on what they (do not) override, or special cases
+m// and s/// which do not do what one would expect them to do.
+
+Help with best setup of these faces for printout requested (for each of 
+the faces: please specify bold, italic, underline, shadow and box.)
+
+\(Not finished.)")
+
 
 
 ;;; Portability stuff:
@@ -1774,6 +1990,8 @@ B) Speed of editing operations.
 	    ["Insert spaces if needed" cperl-find-bad-style t]
 	    ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
 	    ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
+	    ["CPerl pretty print (exprmntl)" cperl-ps-print 
+	     (fboundp 'ps-extend-face-list)]
 	    ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]
 	    ("Tags"
 ;;;	     ["Create tags for current file" cperl-etags t]
@@ -1832,7 +2050,11 @@ B) Speed of editing operations.
 	    ["Non-problems" (describe-variable 'cperl-non-problems) t]
 	    ["Speed" (describe-variable 'cperl-speed) t]
 	    ["Praise" (describe-variable 'cperl-praise) t]
-	    ["CPerl mode" (describe-function 'cperl-mode) 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" 
+		      cperl-version) t]))))
   (error nil))
 
 (autoload 'c-macro-expand "cmacexp"
@@ -2147,7 +2369,7 @@ or as help on variables `cperl-tips', `cperl-problems',
 	;; Fix broken font-lock:
 	(or (boundp 'font-lock-unfontify-region-function)
 	    (set 'font-lock-unfontify-region-function
-		  'font-lock-default-unfontify-buffer))
+		  'font-lock-default-unfontify-region))
 	(make-variable-buffer-local 'font-lock-unfontify-region-function)
 	(set 'font-lock-unfontify-region-function 
 	      'cperl-font-lock-unfontify-region-function)
@@ -2225,13 +2447,28 @@ or as help on variables `cperl-tips', `cperl-problems',
 ;; based on its context.  Do fallback if comment is found wrong.
 
 (defvar cperl-wrong-comment)
+(defvar cperl-st-cfence '(14))		; Comment-fence
+(defvar cperl-st-sfence '(15))		; String-fence
+(defvar cperl-st-punct '(1))
+(defvar cperl-st-word '(2))
+(defvar cperl-st-bra '(4 . ?\>))
+(defvar cperl-st-ket '(5 . ?\<))
+
 
 (defun cperl-comment-indent ()
-  (let ((p (point)) (c (current-column)) was)
+  (let ((p (point)) (c (current-column)) was phony)
     (if (looking-at "^#") 0		; Existing comment at bol stays there.
       ;; Wrong comment found
       (save-excursion
-	(setq was (cperl-to-comment-or-eol))
+	(setq was (cperl-to-comment-or-eol)
+	      phony (eq (get-text-property (point) 'syntax-table)
+			cperl-st-cfence))
+	(if phony
+	    (progn
+	      (re-search-forward "#\\|$") ; Hmm, what about embedded #?
+	      (if (eq (preceding-char) ?\#)
+		  (forward-char -1))
+	      (setq was nil)))
 	(if (= (point) p)
 	    (progn
 	      (skip-chars-backward " \t")
@@ -2935,11 +3172,13 @@ Return the amount the indentation changed by."
 	 (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))))
 
 (defun cperl-get-state (&optional parse-start start-state)
-  ;; returns list (START STATE DEPTH PRESTART), START is a good place
-  ;; to start parsing, STATE is what is returned by
-  ;; `parse-partial-sexp'.  DEPTH is true is we are immediately after
-  ;; end of block which contains START.  PRESTART is the position
-  ;; basing on which START was found.
+  ;; returns list (START STATE DEPTH PRESTART),
+  ;; START is a good place to start parsing, or equal to
+  ;; PARSE-START if preset, 
+  ;; STATE is what is returned by `parse-partial-sexp'.
+  ;; DEPTH is true is we are immediately after end of block
+  ;; which contains START.
+  ;; PRESTART is the position basing on which START was found.
   (save-excursion
     (let ((start-point (point)) depth state start prestart)
       (if (and parse-start
@@ -2960,7 +3199,6 @@ Return the amount the indentation changed by."
 	    (beginning-of-line 2)))	; Go to the next line.
 	(if start (goto-char start)))	; Not at the start of file
       (setq start (point))
-      (if (< start start-point) (setq parse-start start))
       (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
       (list start state depth prestart))))
 
@@ -2990,7 +3228,10 @@ Return the amount the indentation changed by."
 (defun cperl-calculate-indent (&optional parse-data) ; was parse-start
   "Return appropriate indentation for current line as Perl code.
 In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
+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.."
   (save-excursion
     (if (or
 	 (memq (get-text-property (point) 'syntax-type) 
@@ -3030,19 +3271,21 @@ Returns nil if line starts inside a string, t if in a comment."
       (goto-char pre-indent-point)
       (let* ((case-fold-search nil)
 	     (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
-	     (start (nth 0 s-s))
+	     (start (or (nth 2 parse-data) 
+			(nth 0 s-s)))
 	     (state (nth 1 s-s))
 	     (containing-sexp (car (cdr state)))
-	     (start-indent (save-excursion
-			     (goto-char start)
-			     (- (current-indentation)
-				(if (nth 2 s-s) cperl-indent-level 0))))
 	     old-indent)
-	(if parse-data
+	(if (and 
+	     ;;containing-sexp		;; We are buggy at toplevel :-(
+	     parse-data) 
 	    (progn
 	      (setcar parse-data pre-indent-point)
 	      (setcar (cdr parse-data) state)
-	      (setq old-indent (nth 2 parse-data))))
+	      (or (nth 2 parse-data)
+		  (setcar (cddr parse-data) start))
+	      ;; Before this point: end of statement
+	      (setq old-indent (nth 3 parse-data))))
 	;;      (or parse-start (null symbol)
 	;;	  (setq parse-start (symbol-value symbol) 
 	;;		start-indent (nth 2 parse-start) 
@@ -3092,7 +3335,10 @@ Returns nil if line starts inside a string, t if in a comment."
 	       ;; unless that ends in a closeparen without semicolon,
 	       ;; in which case this line is the first argument decl.
 	       (skip-chars-forward " \t")
-	       (+ start-indent
+	       (+ (save-excursion
+		    (goto-char start)
+		    (- (current-indentation)
+		       (if (nth 2 s-s) cperl-indent-level 0)))
 		  (if (= char-after ?{) cperl-continued-brace-offset 0)
 		  (progn
 		    (cperl-backward-to-noncomment (or old-indent (point-min)))
@@ -3101,10 +3347,12 @@ Returns nil if line starts inside a string, t if in a comment."
 		    ;; or function's arg decls.  Set basic-indent accordingly.
 		    ;; Now add a little if this is a continuation line.
 		    (if (or (bobp)
+			    (eq (point) old-indent) ; old-indent was at comment
 			    (eq (preceding-char) ?\;)
 			    ;;  Had ?\) too
 			    (and (eq (preceding-char) ?\})
-				 (cperl-after-block-and-statement-beg start))
+				 (cperl-after-block-and-statement-beg
+				  (point-min)))	; Was start - too close
 			    (memq char-after (append ")]}" nil))
 			    (and (eq (preceding-char) ?\:) ; label
 				 (progn
@@ -3114,7 +3362,7 @@ Returns nil if line starts inside a string, t if in a comment."
 			(progn
 			  (if (and parse-data
 				   (not (eq char-after ?\C-j)))
-			      (setcdr (cdr parse-data)
+			      (setcdr (cddr parse-data)
 				      (list pre-indent-point)))
 			  0)
 		      cperl-continued-statement-offset))))
@@ -3146,11 +3394,13 @@ Returns nil if line starts inside a string, t if in a comment."
 	       (cperl-backward-to-noncomment containing-sexp)
 	       ;; Back up over label lines, since they don't
 	       ;; affect whether our line is a continuation.
-	       (while (or (eq (preceding-char) ?\,)
+	       ;; (Had \, too)
+	       (while ;;(or (eq (preceding-char) ?\,)
 			  (and (eq (preceding-char) ?:)
 			       (or;;(eq (char-after (- (point) 2)) ?\') ; ????
 				(memq (char-syntax (char-after (- (point) 2)))
-				      '(?w ?_)))))
+				      '(?w ?_))))
+			  ;;)
 		 (if (eq (preceding-char) ?\,)
 		     ;; Will go to beginning of line, essentially.
 		     ;; Will ignore embedded sexpr XXXX.
@@ -3166,12 +3416,22 @@ Returns nil if line starts inside a string, t if in a comment."
 		   ;; This line is continuation of preceding line's statement;
 		   ;; indent  `cperl-continued-statement-offset'  more than the
 		   ;; previous line of the statement.
+		   ;;
+		   ;; There might be a label on this line, just
+		   ;; consider it bad style and ignore it.
 		   (progn
 		     (cperl-backward-to-start-of-continued-exp containing-sexp)
 		     (+ (if (memq char-after (append "}])" nil))
 			    0		; Closing parenth
 			  cperl-continued-statement-offset)
-			(current-column)
+			(if (looking-at "\\w+[ \t]*:")
+			    (if (> (current-indentation) cperl-min-label-indent)
+				(- (current-indentation) cperl-label-offset)
+			      ;; Do not move `parse-data', this should
+			      ;; be quick anyway (this comment comes 
+			      ;;from different location):
+			      (cperl-calculate-indent))
+			  (current-column))
 			(if (eq char-after ?\{)
 			    cperl-continued-brace-offset 0)))
 		 ;; This line starts a new statement.
@@ -3487,13 +3747,6 @@ Returns true if comment is found."
 (defsubst cperl-1+ (p)
   (min (point-max) (1+ p)))
 
-(defvar cperl-st-cfence '(14))		; Comment-fence
-(defvar cperl-st-sfence '(15))		; String-fence
-(defvar cperl-st-punct '(1))
-(defvar cperl-st-word '(2))
-(defvar cperl-st-bra '(4 . ?\>))
-(defvar cperl-st-ket '(5 . ?\<))
-
 (defsubst cperl-modify-syntax-type (at how)
   (if (< at (point-max))
       (progn
@@ -3537,7 +3790,7 @@ Returns true if comment is found."
     (skip-chars-forward " \t")
     ;; ender means matching-char matcher.
     (setq b (point) 
-	  starter (char-after b)
+	  starter (if (eobp) 0 (char-after b))
 	  ender (cdr (assoc starter cperl-starters)))
     ;; What if starter == ?\\  ????
     (if set-st
@@ -3642,11 +3895,15 @@ Returns true if comment is found."
 ;;		Start-to-end is marked `here-doc-group' ==> t
 ;;		The body is marked `syntax-type' ==> `here-doc'
 ;;		The delimiter is marked `syntax-type' ==> `here-doc-delim'
-;;	a) FORMATs: 
+;;	c) FORMATs: 
 ;;		After-initial-line--to-end is marked `syntax-type' ==> `format'
+;;	d) 'Q'uoted string: 
+;;		part between markers inclusive is marked `syntax-type' ==> `string'
 
-(defun cperl-unwind-to-safe (before)
-  (let ((pos (point)))
+(defun cperl-unwind-to-safe (before &optional end)
+  ;; if BEFORE, go to the previous start-of-line on each step of unwinding
+  (let ((pos (point)) opos)
+    (setq opos pos)
     (while (and pos (get-text-property pos 'syntax-type))
       (setq pos (previous-single-property-change pos 'syntax-type))
       (if pos
@@ -3657,7 +3914,14 @@ Returns true if comment is found."
 		(setq pos (point)))
 	    (goto-char (setq pos (cperl-1- pos))))
 	;; Up to the start
-	(goto-char (point-min))))))
+	(goto-char (point-min))))
+    (if end
+	;; Do the same for end, going small steps
+	(progn
+	  (while (and end (get-text-property end 'syntax-type))
+	    (setq pos end
+		  end (next-single-property-change end 'syntax-type)))
+	  (or end pos)))))
 
 (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max)
   "Scans the buffer for hard-to-parse Perl constructions.
@@ -3693,10 +3957,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 	       (if (boundp 'font-lock-function-name-face)
 		   font-lock-function-name-face
 		 'font-lock-function-name-face))
-	      (font-lock-other-type-face 
-	       (if (boundp 'font-lock-other-type-face)
-		   font-lock-other-type-face
-		 'font-lock-other-type-face))
+	      (cperl-nonoverridable-face 
+	       (if (boundp 'cperl-nonoverridable-face)
+		   cperl-nonoverridable-face
+		 'cperl-nonoverridable-face))
 	      (stop-point (if ignore-max 
 			      (point-max)
 			    max))
@@ -3970,6 +4234,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      i b
 		      c (char-after (match-beginning b1))
 		      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
@@ -3980,6 +4245,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 					    ?\&))))
 			   ;; <file> or <$file>
 			   (and (eq c ?\<)
+				;; Do not stringify <FH> :
 				(save-match-data
 				  (looking-at 
 				   "\\s *\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\s *\\)?>"))))
@@ -3995,10 +4261,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 				 ;; What is below: regexp-p?
 				 (and
 				  (or (memq (preceding-char)
-					    (append (if (eq c ?\?)
+					    (append (if (memq c '(?\? ?\<))
 							;; $a++ ? 1 : 2
-							"~{(=|&*!,;"
-						      "~{(=|&+-*!,;") nil))
+							"~{(=|&*!,;:"
+						      "~{(=|&+-*!,;:") nil))
 				      (and (eq (preceding-char) ?\})
 					   (cperl-after-block-p (point-min)))
 				      (and (eq (char-syntax (preceding-char)) ?w)
@@ -4069,9 +4335,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      ;; Considered as 1arg form
 		      (progn
 			(cperl-commentify b (point) t)
+			(put-text-property b (point) 'syntax-type 'string)
 			(and go
-			     (setq e1 (1+ e1))
-			     (forward-char 1)))
+			     (setq e1 (cperl-1+ e1))
+			     (or (eobp)
+				 (forward-char 1))))
 		    (cperl-commentify b i t)
 		    (if (looking-at "\\sw*e") ; s///e
 			(progn
@@ -4083,8 +4351,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			  (if (and tag (eq (preceding-char) ?\>))
 			      (progn
 				(cperl-modify-syntax-type (1- (point)) cperl-st-ket)
-				(cperl-modify-syntax-type i cperl-st-bra))))
+				(cperl-modify-syntax-type i cperl-st-bra)))
+			  (put-text-property b i 'syntax-type 'string))
 		      (cperl-commentify b1 (point) t)
+		      (put-text-property b (point) 'syntax-type 'string)
 		      (if qtag
 			  (cperl-modify-syntax-type (1+ i) cperl-st-punct))
 		      (setq tail nil)))
@@ -4094,7 +4364,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			(forward-word 1) ; skip modifiers s///s
 			(if tail (cperl-commentify tail (point) t))
 			(cperl-postpone-fontification 
-			 e1 (point) 'face font-lock-other-type-face)))
+			 e1 (point) 'face cperl-nonoverridable-face)))
 		  ;; Check whether it is m// which means "previous match"
 		  ;; and highlight differently
 		  (if (and (eq e (+ 2 b))
@@ -4118,7 +4388,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 				       (not (eq ?\< (char-after b)))))))
 			(progn
 			  (cperl-postpone-fontification 
-			   b (1+ b) 'face font-lock-constant-face)
+			   b (cperl-1+ b) 'face font-lock-constant-face)
 			  (cperl-postpone-fontification 
 			   (1- e) e 'face font-lock-constant-face))))
 		  (if i2
@@ -4136,8 +4406,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			  '(?\$ ?\@ ?\% ?\& ?\*))
 		    nil
 		  (setq state (parse-partial-sexp 
-			       state-point (1- b) nil nil state)
-			state-point (1- b))
+			       state-point b nil nil state)
+			state-point b)
 		  (if (or (nth 3 state) (nth 4 state))
 		      nil
 		    ;; Mark as string
@@ -4233,7 +4503,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 	      (if (eq (char-syntax (preceding-char)) ?w) ; else {}
 		  (save-excursion
 		    (forward-sexp -1)
-		    (or (looking-at "\\(else\\|grep\\|map\\)\\>")
+		    (or (looking-at "\\(else\\|grep\\|map\\|BEGIN\\|END\\)\\>")
 			;; sub f {}
 			(progn
 			  (cperl-backward-to-noncomment lim)
@@ -4257,11 +4527,19 @@ CHARS is a string that contains good characters to have before us (however,
 	(setq p (point))
 	(beginning-of-line)
 	(if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
-	  ;; Else: last iteration (What to do with labels?)
+	  ;; Else: last iteration, or a label
 	  (cperl-to-comment-or-eol) 
 	  (skip-chars-backward " \t")
 	  (if (< p (point)) (goto-char p))
-	  (setq stop t)))
+	  (setq p (point))
+	  (if (and (eq (preceding-char) ?:)
+		   (progn
+		     (forward-char -1)
+		     (skip-chars-backward " \t\n\f" lim)
+		     (eq (char-syntax (preceding-char)) ?w)))
+	      (forward-sexp -1)		; Possibly label.  Skip it
+	    (goto-char p)
+	    (setq stop t))))
       (or (bobp)			; ???? Needed
 	  (eq (point) lim)
 	  (progn
@@ -4300,8 +4578,9 @@ CHARS is a string that contains good characters to have before us (however,
 
 (defun cperl-indent-exp ()
   "Simple variant of indentation of continued-sexp.
-Should be slow.  Will not indent comment if it starts at `comment-indent'
-or looks like continuation of the comment on the previous line.
+
+Will not indent comment if it starts at `comment-indent' or looks like
+continuation of the comment on the previous line.
 
 If `cperl-indent-region-fix-constructs', will improve spacing on 
 conditional/loop constructs."
@@ -4319,7 +4598,10 @@ conditional/loop constructs."
 	  (while (< (point) tmp-end)
 	    (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
 	    (or (eolp) (forward-sexp 1)))
-	  (if (> (point) tmp-end) (progn (end-of-line) (setq tmp-end (point)))
+	  (if (> (point) tmp-end)
+	      (save-excursion
+		(end-of-line)
+		(setq tmp-end (point)))
 	    (setq done t)))
 	(goto-char tmp-end)
 	(setq tmp-end (point-marker)))
@@ -4328,16 +4610,18 @@ conditional/loop constructs."
       (cperl-indent-region (point) tmp-end))))
 
 (defun cperl-fix-line-spacing (&optional end parse-data)
-  "Improve whitespace in a conditional/loop construct."
+  "Improve whitespace in a conditional/loop construct.
+Returns some position at the last line."
   (interactive)
   (or end
       (setq end (point-max)))
-  (let (p pp ml have-brace
+  (let (p pp ml have-brace ret
 	  (ee (save-excursion (end-of-line) (point)))
 	  (cperl-indent-region-fix-constructs
 	   (or cperl-indent-region-fix-constructs 1)))
     (save-excursion
       (beginning-of-line)
+      (setq ret (point))
       ;;  }? continue 
       ;;  blah; }
       (if (not 
@@ -4429,8 +4713,11 @@ conditional/loop constructs."
 			(progn
 			  (delete-horizontal-space)
 			  (insert "\n")
+			  (setq ret (point))
 			  (if (cperl-indent-line parse-data)
-			      (cperl-fix-line-spacing end parse-data)))
+			      (progn 
+				(cperl-fix-line-spacing end parse-data)
+				(setq ret (point)))))
 		      (insert
 		       (make-string cperl-indent-region-fix-constructs ?\ ))))
 		   ((and (looking-at "[ \t]*\n")
@@ -4457,8 +4744,9 @@ conditional/loop constructs."
 			      (goto-char (1+ pp))
 			      (delete-horizontal-space)
 			      (insert "\n")
+			      (setq ret (point))
 			      (if (cperl-indent-line parse-data)
-				  (cperl-fix-line-spacing end parse-data))))))))))
+				  (setq ret (cperl-fix-line-spacing end parse-data)))))))))))
       (beginning-of-line)
       (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.
       ;; Now check whether there is a hanging `}'
@@ -4494,10 +4782,12 @@ conditional/loop constructs."
 		  (and (eq (preceding-char) ?\} )
 		       (cperl-after-block-p (point-min)))
 		  (insert ";"))
-	      (insert "\n"))
+	      (insert "\n")
+	      (setq ret (point)))
 	    (if (cperl-indent-line parse-data)
-		(cperl-fix-line-spacing end parse-data))
-	    (beginning-of-line)))))))
+		(setq ret (cperl-fix-line-spacing end parse-data)))
+	    (beginning-of-line)))))
+    ret))
 
 (defvar cperl-update-start)		; Do not need to make them local
 (defvar cperl-update-end)
@@ -4518,9 +4808,9 @@ conditional/loop constructs."
   (cperl-update-syntaxification end end)
   (save-excursion
     (let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
-      (let (st comm old-comm-indent new-comm-indent p pp i
+      (let (st comm old-comm-indent new-comm-indent p pp i empty
 	       (indent-info (if cperl-emacs-can-parse
-				(list nil nil) ; Cannot use '(), since will modify
+				(list nil nil nil) ; Cannot use '(), since will modify
 			      nil))
 	       after-change-functions	; Speed it up!
 	       (pm 0) (imenu-scanning-message "Indenting... (%3d%%)"))
@@ -4539,13 +4829,18 @@ conditional/loop constructs."
 	       (imenu-progress-message 
 		pm (/ (* 100 (- (point) start)) (- end start -1))))
 	  (setq st (point))
-	  (if (and (setq comm (looking-at "[ \t]*#"))
-		   (or (eq (current-indentation) (or old-comm-indent 
-						     comment-column))
-		       (setq old-comm-indent nil)))
+	  (if (or
+	       (setq empty (looking-at "[ \t]*\n"))
+	       (and (setq comm (looking-at "[ \t]*#"))
+		    (or (eq (current-indentation) (or old-comm-indent 
+						      comment-column))
+			(setq old-comm-indent nil))))
 	      (if (and old-comm-indent
+		       (not empty)
 		       (= (current-indentation) old-comm-indent)
-		       (not (eq (get-text-property (point) 'syntax-type) 'pod)))
+		       (not (eq (get-text-property (point) 'syntax-type) 'pod))
+		       (not (eq (get-text-property (point) 'syntax-table)
+				cperl-st-cfence)))
 		  (let ((comment-column new-comm-indent))
 		    (indent-for-comment)))
 	    (progn 
@@ -4554,12 +4849,15 @@ conditional/loop constructs."
 		  (not i)
 		  (progn
 		    (if cperl-indent-region-fix-constructs
-			(cperl-fix-line-spacing end indent-info))
+			(goto-char (cperl-fix-line-spacing end indent-info)))
 		    (if (setq old-comm-indent 
 			      (and (cperl-to-comment-or-eol)
 				   (not (memq (get-text-property (point) 
 								 'syntax-type)
 					      '(pod here-doc)))
+				   (not (eq (get-text-property (point) 
+							       'syntax-table)
+					    cperl-st-cfence))
 				   (current-column)))
 			(progn (indent-for-comment)
 			       (skip-chars-backward " \t")
@@ -4917,7 +5215,10 @@ indentation and initial hashes.  Behaves usually outside of comment."
 (defun cperl-init-faces-weak ()
   ;; Allow `cperl-find-pods-heres' to run.
   (or (boundp 'font-lock-constant-face)
-      (setq font-lock-constant-face 'font-lock-constant-face)))
+      (cperl-force-face font-lock-constant-face
+                        "Face for constant and label names")
+      ;;(setq font-lock-constant-face 'font-lock-constant-face)
+      ))
 
 (defun cperl-init-faces ()
   (condition-case errs
@@ -4932,6 +5233,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	  (setq 
 	   t-font-lock-keywords
 	   (list
+	    (list "[ \t]+$" 0 cperl-invalid-face t)
 	    (cons
 	     (concat
 	      "\\(^\\|[^$@%&\\]\\)\\<\\("
@@ -5038,14 +5340,14 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	      "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
 	      "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
 	      "\\|[sm]"			; Added manually
-	      "\\)\\>") 2 'font-lock-other-type-face)
+	      "\\)\\>") 2 'cperl-nonoverridable-face)
 	    ;;		(mapconcat 'identity
 	    ;;			   '("#endif" "#else" "#ifdef" "#ifndef" "#if"
 	    ;;			     "#include" "#define" "#undef")
 	    ;;			   "\\|")
 	    '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
 	      font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
-	    '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1
+	    '("\\<sub[ \t]+\\([^ \t{;()]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1
 	      font-lock-function-name-face)
 	    '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
 	      2 font-lock-function-name-face)
@@ -5140,12 +5442,6 @@ indentation and initial hashes.  Behaves usually outside of comment."
 		    nil
 		    [nil		nil		t		t	t]
 		    nil)
-	      (list 'font-lock-keyword-face
-		    ["Purple"		"LightSteelBlue" "DimGray"	"Gray90"]
-		    nil
-		    [nil		nil		t		t	t]
-		    nil
-		    nil)
 	      (list 'font-lock-function-name-face
 		    (vector
 		     "Blue"		"LightSkyBlue"	"Gray50"	"LightGray"
@@ -5178,7 +5474,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
 		    nil
 		    [nil		nil		t		t	t]
 		    )
-	      (list 'font-lock-other-type-face
+	      (list 'cperl-nonoverridable-face
 		    ["chartreuse3"	("orchid1" "orange")
 		     nil		"Gray80"]
 		    [nil		nil		"gray90"]
@@ -5216,12 +5512,10 @@ indentation and initial hashes.  Behaves usually outside of comment."
 			    "Face for variable names")
 	  (cperl-force-face font-lock-type-face
 			    "Face for data types")
-	  (cperl-force-face font-lock-other-type-face
+	  (cperl-force-face cperl-nonoverridable-face
 			    "Face for data types from another group")
 	  (cperl-force-face font-lock-comment-face
 			    "Face for comments")
-	  (cperl-force-face font-lock-keyword-face
-			    "Face for keywords")
 	  (cperl-force-face font-lock-function-name-face
 			    "Face for function names")
 	  (cperl-force-face cperl-hash-face
@@ -5234,9 +5528,9 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	  ;;    (defconst font-lock-type-face
 	  ;;	'font-lock-type-face
 	  ;;	"Face to use for data types."))
-	  ;;(or (boundp 'font-lock-other-type-face)
-	  ;;    (defconst font-lock-other-type-face
-	  ;;	'font-lock-other-type-face
+	  ;;(or (boundp 'cperl-nonoverridable-face)
+	  ;;    (defconst cperl-nonoverridable-face
+	  ;;	'cperl-nonoverridable-face
 	  ;;	"Face to use for data types from another group."))
 	  ;;(if (not cperl-xemacs-p) nil
 	  ;;  (or (boundp 'font-lock-comment-face)
@@ -5260,6 +5554,11 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	       (cperl-is-face 'font-lock-other-emphasized-face)) 
 	      (copy-face 'font-lock-other-emphasized-face 
 			 'cperl-hash-face))
+	  (if (and
+	       (not (cperl-is-face 'cperl-nonoverridable-face)) 
+	       (cperl-is-face 'font-lock-other-type-face)) 
+	      (copy-face 'font-lock-other-type-face 
+			 'cperl-nonoverridable-face))
 	  ;;(or (boundp 'cperl-hash-face)
 	  ;;    (defconst cperl-hash-face
 	  ;;	'cperl-hash-face
@@ -5308,54 +5607,54 @@ indentation and initial hashes.  Behaves usually outside of comment."
 				       "pink")))
 	       (t
 		(set-face-background 'font-lock-type-face "gray90"))))
-	    (if (cperl-is-face 'font-lock-other-type-face)
+	    (if (cperl-is-face 'cperl-nonoverridable-face)
 		nil
-	      (copy-face 'font-lock-type-face 'font-lock-other-type-face)
+	      (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
 	      (cond
 	       ((eq background 'light)
-		(set-face-foreground 'font-lock-other-type-face
+		(set-face-foreground 'cperl-nonoverridable-face
 				     (if (x-color-defined-p "chartreuse3")
 					 "chartreuse3"
 				       "chartreuse")))
 	       ((eq background 'dark)
-		(set-face-foreground 'font-lock-other-type-face
+		(set-face-foreground 'cperl-nonoverridable-face
 				     (if (x-color-defined-p "orchid1")
 					 "orchid1"
 				       "orange")))))
-	    (if (cperl-is-face 'font-lock-other-emphasized-face) nil
-	      (copy-face 'bold-italic 'font-lock-other-emphasized-face)
-	      (cond
-	       ((eq background 'light)
-		(set-face-background 'font-lock-other-emphasized-face
-				     (if (x-color-defined-p "lightyellow2")
-					 "lightyellow2"
-				       (if (x-color-defined-p "lightyellow")
-					   "lightyellow"
-					 "light yellow"))))
-	       ((eq background 'dark)
-		(set-face-background 'font-lock-other-emphasized-face
-				     (if (x-color-defined-p "navy")
-					 "navy"
-				       (if (x-color-defined-p "darkgreen")
-					   "darkgreen"
-					 "dark green"))))
-	       (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
-	    (if (cperl-is-face 'font-lock-emphasized-face) nil
-	      (copy-face 'bold 'font-lock-emphasized-face)
-	      (cond
-	       ((eq background 'light)
-		(set-face-background 'font-lock-emphasized-face
-				     (if (x-color-defined-p "lightyellow2")
-					 "lightyellow2"
-				       "lightyellow")))
-	       ((eq background 'dark)
-		(set-face-background 'font-lock-emphasized-face
-				     (if (x-color-defined-p "navy")
-					 "navy"
-				       (if (x-color-defined-p "darkgreen")
-					   "darkgreen"
-					 "dark green"))))
-	       (t (set-face-background 'font-lock-emphasized-face "gray90"))))
+;;;	    (if (cperl-is-face 'font-lock-other-emphasized-face) nil
+;;;	      (copy-face 'bold-italic 'font-lock-other-emphasized-face)
+;;;	      (cond
+;;;	       ((eq background 'light)
+;;;		(set-face-background 'font-lock-other-emphasized-face
+;;;				     (if (x-color-defined-p "lightyellow2")
+;;;					 "lightyellow2"
+;;;				       (if (x-color-defined-p "lightyellow")
+;;;					   "lightyellow"
+;;;					 "light yellow"))))
+;;;	       ((eq background 'dark)
+;;;		(set-face-background 'font-lock-other-emphasized-face
+;;;				     (if (x-color-defined-p "navy")
+;;;					 "navy"
+;;;				       (if (x-color-defined-p "darkgreen")
+;;;					   "darkgreen"
+;;;					 "dark green"))))
+;;;	       (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
+;;;	    (if (cperl-is-face 'font-lock-emphasized-face) nil
+;;;	      (copy-face 'bold 'font-lock-emphasized-face)
+;;;	      (cond
+;;;	       ((eq background 'light)
+;;;		(set-face-background 'font-lock-emphasized-face
+;;;				     (if (x-color-defined-p "lightyellow2")
+;;;					 "lightyellow2"
+;;;				       "lightyellow")))
+;;;	       ((eq background 'dark)
+;;;		(set-face-background 'font-lock-emphasized-face
+;;;				     (if (x-color-defined-p "navy")
+;;;					 "navy"
+;;;				       (if (x-color-defined-p "darkgreen")
+;;;					   "darkgreen"
+;;;					 "dark green"))))
+;;;	       (t (set-face-background 'font-lock-emphasized-face "gray90"))))
 	    (if (cperl-is-face 'font-lock-variable-name-face) nil
 	      (copy-face 'italic 'font-lock-variable-name-face))
 	    (if (cperl-is-face 'font-lock-constant-face) nil
@@ -5366,30 +5665,79 @@ indentation and initial hashes.  Behaves usually outside of comment."
 
 (defun cperl-ps-print-init ()
   "Initialization of `ps-print' components for faces used in CPerl."
-  ;; Guard against old versions
-  (defvar ps-underlined-faces nil)
-  (defvar ps-bold-faces nil)
-  (defvar ps-italic-faces nil)
-  (setq ps-bold-faces
-	(append '(font-lock-emphasized-face
-		  font-lock-keyword-face 
-		  font-lock-variable-name-face 
-		  font-lock-constant-face 
-		  font-lock-reference-face 
-		  font-lock-other-emphasized-face) 
-		ps-bold-faces))
-  (setq ps-italic-faces
-	(append '(font-lock-other-type-face
-		  font-lock-constant-face 
-		  font-lock-reference-face 
-		  font-lock-other-emphasized-face)
-		ps-italic-faces))
-  (setq ps-underlined-faces
-	(append '(font-lock-emphasized-face
-		  font-lock-other-emphasized-face 
-		  font-lock-other-type-face font-lock-type-face)
-		ps-underlined-faces))
-  (cons 'font-lock-type-face ps-underlined-faces))
+  (eval-after-load "ps-print"
+    '(setq ps-bold-faces
+	   ;; 			font-lock-variable-name-face 
+	   ;;			font-lock-constant-face
+	   (append '(cperl-array-face
+		     cperl-hash-face) 
+		   ps-bold-faces)
+	   ps-italic-faces
+	   ;;			font-lock-constant-face
+	   (append '(cperl-nonoverridable-face
+		     cperl-hash-face)
+		   ps-italic-faces)
+	   ps-underlined-faces
+	   ;;	     font-lock-type-face
+	   (append '(cperl-array-face
+		     cperl-hash-face
+		     underline
+		     cperl-nonoverridable-face)
+		   ps-underlined-faces))))
+
+(defvar ps-print-face-extension-alist)
+
+(defun cperl-ps-print (&optional file)
+  "Pretty-print in CPerl style.
+If optional argument FILE is an empty string, prints to printer, otherwise
+to the file FILE.  If FILE is nil, prompts for a file name.
+
+Style of printout regulated by the variable `cperl-ps-print-face-properties'."
+  (interactive)
+  (or file 
+      (setq file (read-from-minibuffer 
+		  "Print to file (if empty - to printer): "
+		  (concat (buffer-file-name) ".ps")
+		  nil nil 'file-name-history)))
+  (or (> (length file) 0)
+      (setq file nil))
+  (require 'ps-print)			; To get ps-print-face-extension-alist
+  (let ((ps-print-color-p t)
+	(ps-print-face-extension-alist ps-print-face-extension-alist))
+    (cperl-ps-extend-face-list cperl-ps-print-face-properties)
+    (ps-print-buffer-with-faces file)))
+
+;;; (defun cperl-ps-print-init ()
+;;;   "Initialization of `ps-print' components for faces used in CPerl."
+;;;   ;; Guard against old versions
+;;;   (defvar ps-underlined-faces nil)
+;;;   (defvar ps-bold-faces nil)
+;;;   (defvar ps-italic-faces nil)
+;;;   (setq ps-bold-faces
+;;; 	(append '(font-lock-emphasized-face
+;;; 		  cperl-array-face
+;;; 		  font-lock-keyword-face 
+;;; 		  font-lock-variable-name-face 
+;;; 		  font-lock-constant-face 
+;;; 		  font-lock-reference-face 
+;;; 		  font-lock-other-emphasized-face
+;;; 		  cperl-hash-face) 
+;;; 		ps-bold-faces))
+;;;   (setq ps-italic-faces
+;;; 	(append '(cperl-nonoverridable-face
+;;; 		  font-lock-constant-face 
+;;; 		  font-lock-reference-face 
+;;; 		  font-lock-other-emphasized-face
+;;; 		  cperl-hash-face)
+;;; 		ps-italic-faces))
+;;;   (setq ps-underlined-faces
+;;; 	(append '(font-lock-emphasized-face
+;;; 		  cperl-array-face
+;;; 		  font-lock-other-emphasized-face
+;;; 		  cperl-hash-face
+;;; 		  cperl-nonoverridable-face font-lock-type-face)
+;;; 		ps-underlined-faces))
+;;;   (cons 'font-lock-type-face ps-underlined-faces))
 
 
 (if (cperl-enable-font-lock) (cperl-windowed-init))
@@ -5457,7 +5805,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
      ;;(cperl-extra-newline-before-brace .  nil) ; ???
      (cperl-continued-statement-offset .  4)))
   "(Experimental) list of variables to set to get a particular indentation style.
-Should be used via `cperl-set-style' or via CPerl menu.")
+Should be used via `cperl-set-style' or via Perl menu.")
 
 (defun cperl-set-style (style)
   "Set CPerl-mode variables to use one of several different indentation styles.
@@ -5799,7 +6147,9 @@ See `cperl-lazy-help-time' too."
   "Toggle whether `indent-region'/`indent-sexp' fix whitespace too."
   (interactive)
   (setq cperl-indent-region-fix-constructs 
-	(not cperl-indent-region-fix-constructs))
+	(if cperl-indent-region-fix-constructs
+	    nil
+	  1))
   (message "indent-region/indent-sexp will %sbe automatically fix whitespace." 
 	   (if cperl-indent-region-fix-constructs "" "not ")))
 
@@ -5889,8 +6239,10 @@ See `cperl-lazy-help-time' too."
 	      (lambda (elt)
 		(cond ((string-match "^[_a-zA-Z]" (car elt))
 		       (goto-char (cdr elt))
+		       (beginning-of-line) ; pos should be of the start of the line
 		       (list (car elt) 
-			     (point) (count-lines 1 (point))
+			     (point) 
+			     (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
 			     (buffer-substring (progn
 						 (skip-chars-forward 
 						  ":_a-zA-Z0-9")
@@ -5911,9 +6263,9 @@ See `cperl-lazy-help-time' too."
 			  (substring (car elt) 8)
 			(car elt) )
 		      1
-		      (number-to-string (elt elt 1))
+		      (number-to-string (elt elt 2)) ; Line
 		      ","
-		      (number-to-string (elt elt 2))
+		      (number-to-string (1- (elt elt 1))) ; Char pos 0-based
 		      "\n")
 	      (if (and (string-match "^[_a-zA-Z]+::" (car elt))
 		       (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]"
@@ -5965,11 +6317,13 @@ Use as
       (setq topdir default-directory))
   (let ((tags-file-name "TAGS")
 	(case-fold-search (eq system-type 'emx))
-	xs)
+	xs rel)
     (save-excursion
       (cond (inbuffer nil)		; Already there
 	    ((file-exists-p tags-file-name)
-	     (visit-tags-table-buffer tags-file-name))
+	     (if cperl-xemacs-p
+		 (visit-tags-table-buffer)
+	      (visit-tags-table-buffer tags-file-name)))
 	    (t (set-buffer (find-file-noselect tags-file-name))))
       (cond
        (dir
@@ -6000,7 +6354,12 @@ Use as
 		  (erase (erase-buffer))
 		  (t
 		   (goto-char 1)
-		   (if (search-forward (concat "\f\n" file ",") nil t)
+		   (setq rel file)
+		   ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
+		   (set-text-properties 0 (length rel) nil rel)
+		   (and (equal topdir (substring rel 0 (length topdir)))
+			(setq rel (substring file (length topdir))))
+		   (if (search-forward (concat "\f\n" rel ",") nil t)
 		       (progn
 			 (search-backward "\f\n")
 			 (delete-region (point)
@@ -6052,11 +6411,12 @@ Use as
 	    (setq ;;str (buffer-substring (match-beginning 1) (match-end 1))
 		  name (buffer-substring (match-beginning 2) (match-end 2))
 		  ;;pos (buffer-substring (match-beginning 3) (match-end 3))
-		  line (buffer-substring (match-beginning 4) (match-end 4))
+		  line (buffer-substring (match-beginning 3) (match-end 3))
 		  ord (if pack 1 0)
-		  info (etags-snarf-tag) ; Moves to beginning of the next line
 		  file (file-of-tag)
-		  fileind (format "%s:%s" file line))
+		  fileind (format "%s:%s" file line)
+		  ;; Moves to beginning of the next line:
+		  info (cperl-etags-snarf-tag file line))
 	    ;; Move back
 	    (forward-char -1)
 	    ;; Make new member of hierarchy name ==> file ==> pos if needed
@@ -6082,22 +6442,31 @@ One may build such TAGS files from CPerl mode menu."
   (require 'etags)
   (require 'imenu)
   (if (or update (null (nth 2 cperl-hierarchy)))
-      (let (pack name cons1 to l1 l2 l3 l4
+      (let (pack name cons1 to l1 l2 l3 l4 b
 		 (remover (function (lambda (elt) ; (name (file1...) (file2..))
 				      (or (nthcdr 2 elt)
 					  ;; Only in one file
 					  (setcdr elt (cdr (nth 1 elt))))))))
 	;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
 	(setq cperl-hierarchy (list l1 l2 l3))
-	(or tags-table-list
-	    (call-interactively 'visit-tags-table))
-	(message "Updating list of classes...")
-	(mapcar 
-	 (function
-	  (lambda (tagsfile)
-	    (set-buffer (get-file-buffer tagsfile))
-	    (cperl-tags-hier-fill)))
-	 tags-table-list)
+	(if cperl-xemacs-p		; Not checked
+	    (progn
+	      (or tags-file-name
+		  ;; Does this work in XEmacs?
+		  (call-interactively 'visit-tags-table))
+	      (message "Updating list of classes...")
+	      (set-buffer (get-file-buffer tags-file-name))
+	      (cperl-tags-hier-fill))
+	  (or tags-table-list
+	      (call-interactively 'visit-tags-table))
+	  (mapcar 
+	   (function
+	    (lambda (tagsfile)
+	      (message "Updating list of classes... %s" tagsfile)
+	      (set-buffer (get-file-buffer tagsfile))
+	      (cperl-tags-hier-fill)))
+	   tags-table-list)
+	  (message "Updating list of classes... postprocessing..."))
 	(mapcar remover (car cperl-hierarchy))
 	(mapcar remover (nth 1 cperl-hierarchy))
 	(setq to (list nil (cons "Packages: " (nth 1 cperl-hierarchy))
@@ -6122,7 +6491,7 @@ One may build such TAGS files from CPerl mode menu."
   (if (vectorp update) 
       (progn
 	(find-file (elt update 0))
-	(etags-goto-tag-location (elt update 1))))
+	(cperl-etags-goto-tag-location (elt update 1))))
   (if (eq update -999) (cperl-tags-hier-init t)))
 
 (defun cperl-tags-treeify (to level)
@@ -7127,7 +7496,7 @@ We suppose that the regexp is scanned already."
       (or done (forward-char -1)))))
 
 (defun cperl-contract-level ()
-  "Find an enclosing group in regexp and contract it.  Unfinished.
+  "Find an enclosing group in regexp and contract it.
 \(Experimental, may change semantics, recheck the result.)
 We suppose that the regexp is scanned already."
   (interactive)
@@ -7150,7 +7519,7 @@ We suppose that the regexp is scanned already."
 	(just-one-space))))))
 
 (defun cperl-contract-levels ()
-  "Find an enclosing group in regexp and contract all the kids.  Unfinished.
+  "Find an enclosing group in regexp and contract all the kids.
 \(Experimental, may change semantics, recheck the result.)
 We suppose that the regexp is scanned already."
   (interactive)
@@ -7388,9 +7757,12 @@ We suppose that the regexp is scanned already."
 
 (defvar cperl-d-l nil)
 (defun cperl-fontify-syntaxically (end)
-  (and cperl-syntaxify-unwind
-       (cperl-unwind-to-safe t))
-  (let ((start (point)) (dbg (point)))
+  ;; Some vars for debugging only
+  (let (start (dbg (point)) (iend end) 
+	(istate (car cperl-syntax-state)))
+    (and cperl-syntaxify-unwind
+	 (setq end (cperl-unwind-to-safe t end)))
+    (setq start (point))
     (or cperl-syntax-done-to
 	(setq cperl-syntax-done-to (point-min)))
     (if (or (not (boundp 'font-lock-hot-pass))
@@ -7410,9 +7782,10 @@ We suppose that the regexp is scanned already."
 	;;(princ (format "Syntaxifying %s..%s from %s to %s\n" 
 		;;       dbg end start cperl-syntax-done-to)))
     (if (eq cperl-syntaxify-by-font-lock 'message)
-	(message "Syntaxified %s..%s from %s to %s, state at %s" 
-		 dbg end start cperl-syntax-done-to
-		 (car cperl-syntax-state))) ; For debugging 
+	(message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s" 
+		 dbg iend 
+		 start end cperl-syntax-done-to 
+		 istate (car cperl-syntax-state))) ; For debugging 
     nil))				; Do not iterate
 
 (defun cperl-fontify-update (end)
@@ -7434,6 +7807,12 @@ We suppose that the regexp is scanned already."
 	  (goto-char from)
 	  (cperl-fontify-syntaxically to)))))
 
+(defvar cperl-version 
+  (let ((v  "$Revision: 4.19 $"))
+    (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.")
+
 (provide 'cperl-mode)
 
 ;;; cperl-mode.el ends here