/[emacs]/emacs/lisp/progmodes/cperl-mode.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/cperl-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.41 by lektu, Tue Feb 18 12:49:26 2003 UTC revision 1.42 by monnier, Sun Feb 23 01:42:24 2003 UTC
# Line 1  Line 1 
1  ;;; cperl-mode.el --- Perl code editing commands for Emacs  ;;; cperl-mode.el --- Perl code editing commands for Emacs
2    
3  ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 1997  ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2003
4  ;;     Free Software Foundation, Inc.  ;;     Free Software Foundation, Inc.
5    
6  ;; Author: Ilya Zakharevich and Bob Olson  ;; Author: Ilya Zakharevich and Bob Olson
7  ;; Maintainer: Ilya Zakharevich <ilya@math.ohio-state.edu>  ;; Maintainer: Ilya Zakharevich <cperl@ilyaz.org>
8  ;; Keywords: languages, Perl  ;; Keywords: languages, Perl
9    
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 24  Line 24 
24  ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,  ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25  ;; Boston, MA 02111-1307, USA.  ;; Boston, MA 02111-1307, USA.
26    
27  ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu  ;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org
28    
29  ;;; Commentary:  ;;; Commentary:
30    
31  ;;; You can either fine-tune the bells and whistles of this mode or  ;; You can either fine-tune the bells and whistles of this mode or
32  ;;; bulk enable them by putting  ;; bulk enable them by putting
33    
34  ;; (setq cperl-hairy t)  ;; (setq cperl-hairy t)
35    
36  ;;; in your .emacs file.  (Emacs rulers do not consider it politically  ;; in your .emacs file.  (Emacs rulers do not consider it politically
37  ;;; correct to make whistles enabled by default.)  ;; correct to make whistles enabled by default.)
38    
39  ;;; DO NOT FORGET to read micro-docs (available from `Perl' menu)   <<<<<<  ;; DO NOT FORGET to read micro-docs (available from `Perl' menu)   <<<<<<
40  ;;; or as help on variables `cperl-tips', `cperl-problems',         <<<<<<  ;; or as help on variables `cperl-tips', `cperl-problems',         <<<<<<
41  ;;; `cperl-praise', `cperl-speed'.                                  <<<<<<  ;; `cperl-praise', `cperl-speed'.                                   <<<<<<
42    
43  ;;; The mode information (on C-h m) provides some customization help.  ;; The mode information (on C-h m) provides some customization help.
44  ;;; If you use font-lock feature of this mode, it is advisable to use  ;; If you use font-lock feature of this mode, it is advisable to use
45  ;;; either lazy-lock-mode or fast-lock-mode.  I prefer lazy-lock.  ;; either lazy-lock-mode or fast-lock-mode.  I prefer lazy-lock.
46    
47  ;;; Faces used now: three faces for first-class and second-class keywords  ;; Faces used now: three faces for first-class and second-class keywords
48  ;;; and control flow words, one for each: comments, string, labels,  ;; and control flow words, one for each: comments, string, labels,
49  ;;; functions definitions and packages, arrays, hashes, and variable  ;; functions definitions and packages, arrays, hashes, and variable
50  ;;; definitions.  If you do not see all these faces, your font-lock does  ;; definitions.  If you do not see all these faces, your font-lock does
51  ;;; not define them, so you need to define them manually.  ;; not define them, so you need to define them manually.
52    
53  ;;; into your .emacs file.  ;; This mode supports font-lock, imenu and mode-compile.  In the
54    ;; hairy version font-lock is on, but you should activate imenu
55  ;;;; This mode supports font-lock, imenu and mode-compile.  In the  ;; yourself (note that mode-compile is not standard yet).  Well, you
56  ;;;; hairy version font-lock is on, but you should activate imenu  ;; can use imenu from keyboard anyway (M-x imenu), but it is better
57  ;;;; yourself (note that mode-compile is not standard yet).  Well, you  ;; to bind it like that:
 ;;;; can use imenu from keyboard anyway (M-x imenu), but it is better  
 ;;;; to bind it like that:  
58    
59  ;; (define-key global-map [M-S-down-mouse-3] 'imenu)  ;; (define-key global-map [M-S-down-mouse-3] 'imenu)
60    
61    ;;; Font lock bugs as of v4.32:
62    
63    ;; The following kinds of Perl code erroneously start strings:
64    ;; \$`  \$'  \$"
65    ;; $opt::s  $opt_s  $opt{s}  (s => ...)  /\s+.../
66    ;; likewise with m, tr, y, q, qX instead of s
67    
68  ;;; Code:  ;;; Code:
69    
70  ;; Some macros are needed for `defcustom'  ;; Some macros are needed for `defcustom'
71  (eval-when-compile  (eval-when-compile
72    (require 'font-lock)    (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
73      (defvar cperl-can-font-lock
74        (or cperl-xemacs-p
75            (and (boundp 'emacs-major-version)
76                    (or window-system
77                        (> emacs-major-version 20)))))
78      (if cperl-can-font-lock
79          (require 'font-lock))
80    (defvar msb-menu-cond)    (defvar msb-menu-cond)
81    (defvar gud-perldb-history)    (defvar gud-perldb-history)
82    (defvar font-lock-background-mode)    ; not in Emacs    (defvar font-lock-background-mode)    ; not in Emacs
83    (defvar font-lock-display-type)       ; ditto    (defvar font-lock-display-type)       ; ditto
   (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))  
84    (defmacro cperl-is-face (arg)         ; Takes quoted arg    (defmacro cperl-is-face (arg)         ; Takes quoted arg
85      (cond ((fboundp 'find-face)      (cond ((fboundp 'find-face)
86             `(find-face ,arg))             `(find-face ,arg))
# Line 112  Line 123 
123        `(etags-goto-tag-location ,elt)))        `(etags-goto-tag-location ,elt)))
124    (autoload 'tmm-prompt "tmm"))    (autoload 'tmm-prompt "tmm"))
125    
126    (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
127    
128    (defvar cperl-can-font-lock
129      (or cperl-xemacs-p
130          (and (boundp 'emacs-major-version)
131               (or window-system
132                   (> emacs-major-version 20)))))
133    
134  (defun cperl-choose-color (&rest list)  (defun cperl-choose-color (&rest list)
135    (let (answer)    (let (answer)
136      (while list      (while list
# Line 170  and do constructs look like: Line 189  and do constructs look like:
189  instead of:  instead of:
190    
191          if () {          if () {
192          }          }"
 "  
193    :type 'boolean    :type 'boolean
194    :group 'cperl-autoinsert-details)    :group 'cperl-autoinsert-details)
195    
# Line 354  Can be overwritten by `cperl-hairy' to b Line 372  Can be overwritten by `cperl-hairy' to b
372    :group 'cperl-affected-by-hairy)    :group 'cperl-affected-by-hairy)
373    
374  (defcustom cperl-pod-face 'font-lock-comment-face  (defcustom cperl-pod-face 'font-lock-comment-face
375    "*Face for pod highlighting."    "*Face for POD highlighting."
376    :type 'face    :type 'face
377    :group 'cperl-faces)    :group 'cperl-faces)
378    
379  (defcustom cperl-pod-head-face 'font-lock-variable-name-face  (defcustom cperl-pod-head-face 'font-lock-variable-name-face
380    "*Face for pod highlighting.    "*Face for POD highlighting.
381  Font for POD headers."  Font for POD headers."
382    :type 'face    :type 'face
383    :group 'cperl-faces)    :group 'cperl-faces)
# Line 376  Font for POD headers." Line 394  Font for POD headers."
394    :group 'cperl-faces)    :group 'cperl-faces)
395    
396  (defcustom cperl-pod-here-fontify '(featurep 'font-lock)  (defcustom cperl-pod-here-fontify '(featurep 'font-lock)
397    "*Not-nil after evaluation means to highlight pod and here-docs sections."    "*Not-nil after evaluation means to highlight POD and here-docs sections."
398    :type 'boolean    :type 'boolean
399    :group 'cperl-faces)    :group 'cperl-faces)
400    
# Line 395  entered CPerl mode the first time will h Line 413  entered CPerl mode the first time will h
413    :group 'cperl)    :group 'cperl)
414    
415  (defcustom cperl-pod-here-scan t  (defcustom cperl-pod-here-scan t
416    "*Not-nil means look for pod and here-docs sections during startup.    "*Not-nil means look for POD and here-docs sections during startup.
417  You can always make lookup from menu or using \\[cperl-find-pods-heres]."  You can always make lookup from menu or using \\[cperl-find-pods-heres]."
418    :type 'boolean    :type 'boolean
419    :group 'cperl-speed)    :group 'cperl-speed)
# Line 512  One should tune up `cperl-close-paren-of Line 530  One should tune up `cperl-close-paren-of
530    :group 'cperl-indentation-details)    :group 'cperl-indentation-details)
531    
532  (defcustom cperl-syntaxify-by-font-lock  (defcustom cperl-syntaxify-by-font-lock
533    (and window-system    (and cperl-can-font-lock
534         (boundp 'parse-sexp-lookup-properties))         (boundp 'parse-sexp-lookup-properties))
535    "*Non-nil means that CPerl uses `font-lock's routines for syntaxification."    "*Non-nil means that CPerl uses `font-lock's routines for syntaxification."
536    :type '(choice (const message) boolean)    :type '(choice (const message) boolean)
# Line 593  when syntaxifying a chunk of buffer." Line 611  when syntaxifying a chunk of buffer."
611  ;;; Short extra-docs.  ;;; Short extra-docs.
612    
613  (defvar cperl-tips 'please-ignore-this-line  (defvar cperl-tips 'please-ignore-this-line
614    "Get newest version of this package from    "Get maybe newer version of this package from
615    ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs    ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
616  and/or  and/or
617    ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl    ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
# Line 602  patches to related files. Line 620  patches to related files.
620    
621  For best results apply to an older Emacs the patches from  For best results apply to an older Emacs the patches from
622    ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches    ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches
623  \(this upgrades syntax-parsing abilities of Emaxen v19.34 and  \(this upgrades syntax-parsing abilities of Emacsen v19.34 and
624  v20.2 up to the level of Emacs v20.3 - a must for a good Perl  v20.2 up to the level of Emacs v20.3 - a must for a good Perl
625  mode.)  mode.)  As of beginning of 2003, XEmacs may provide a similar ability.
626    
627  Get support packages choose-color.el (or font-lock-extra.el before  Get support packages choose-color.el (or font-lock-extra.el before
628  19.30), imenu-go.el from the same place.  \(Look for other files there  19.30), imenu-go.el from the same place.  \(Look for other files there
# Line 664  yet. Line 682  yet.
682  Emacs had a _very_ restricted syntax parsing engine until version  Emacs had a _very_ restricted syntax parsing engine until version
683  20.1.  Most problems below are corrected starting from this version of  20.1.  Most problems below are corrected starting from this version of
684  Emacs, and all of them should be fixed in version 20.3.  (Or apply  Emacs, and all of them should be fixed in version 20.3.  (Or apply
685  patches to Emacs 19.33/34 - see tips.)  patches to Emacs 19.33/34 - see tips.)  XEmacs was very backward in
686    this respect (until 2003).
687    
688  Note that even with newer Emacsen in some very rare cases the details  Note that even with newer Emacsen in some very rare cases the details
689  of interaction of `font-lock' and syntaxification may be not cleaned  of interaction of `font-lock' and syntaxification may be not cleaned
# Line 681  braces. Line 700  braces.
700    
701  This may be confusing, since the regexp s#//#/#\; may be highlighted  This may be confusing, since the regexp s#//#/#\; may be highlighted
702  as a comment, but it will be recognized as a regexp by the indentation  as a comment, but it will be recognized as a regexp by the indentation
703  code.  Or the opposite case, when a pod section is highlighted, but  code.  Or the opposite case, when a POD section is highlighted, but
704  may break the indentation of the following code (though indentation  may break the indentation of the following code (though indentation
705  should work if the balance of delimiters is not broken by POD).  should work if the balance of delimiters is not broken by POD).
706    
# Line 699  and on CPAN. Line 718  and on CPAN.
718    
719  If these bugs cannot be fixed on your machine (say, you have an inferior  If these bugs cannot be fixed on your machine (say, you have an inferior
720  environment and cannot recompile), you may still disable all the fancy stuff  environment and cannot recompile), you may still disable all the fancy stuff
721  via `cperl-use-syntax-table-text-property'." )  via `cperl-use-syntax-table-text-property'.")
722    
723  (defvar cperl-praise 'please-ignore-this-line  (defvar cperl-praise 'please-ignore-this-line
724    "Advantages of CPerl mode.    "Advantages of CPerl mode.
# Line 783  the settings present before the switch. Line 802  the settings present before the switch.
802  line-breaks/spacing between elements of the construct.  line-breaks/spacing between elements of the construct.
803    
804  10) Uses a linear-time algorith for indentation of regions (on Emaxen with  10) Uses a linear-time algorith for indentation of regions (on Emaxen with
805  capable syntax engines).  capable syntax engines).")
 ")  
806    
807  (defvar cperl-speed 'please-ignore-this-line  (defvar cperl-speed 'please-ignore-this-line
808    "This is an incomplete compendium of what is available in other parts    "This is an incomplete compendium of what is available in other parts
# Line 828  B) Speed of editing operations. Line 846  B) Speed of editing operations.
846      wrongly matched parentheses, wrong indentation, etc.      wrongly matched parentheses, wrong indentation, etc.
847    
848      One can unset `cperl-syntaxify-unwind'.  This might speed up editing      One can unset `cperl-syntaxify-unwind'.  This might speed up editing
849      of, say, long POD sections.      of, say, long POD sections.")
 ")  
850    
851  (defvar cperl-tips-faces 'please-ignore-this-line  (defvar cperl-tips-faces 'please-ignore-this-line
852    "CPerl mode uses following faces for highlighting:    "CPerl mode uses following faces for highlighting:
# Line 870  the faces: please specify bold, italic, Line 887  the faces: please specify bold, italic,
887    
888  ;;; Portability stuff:  ;;; Portability stuff:
889    
 (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))  
   
890  (defmacro cperl-define-key (emacs-key definition &optional xemacs-key)  (defmacro cperl-define-key (emacs-key definition &optional xemacs-key)
891    `(define-key cperl-mode-map    `(define-key cperl-mode-map
892       ,(if xemacs-key       ,(if xemacs-key
# Line 899  the faces: please specify bold, italic, Line 914  the faces: please specify bold, italic,
914    (defun cperl-mark-active () mark-active))    (defun cperl-mark-active () mark-active))
915    
916  (defsubst cperl-enable-font-lock ()  (defsubst cperl-enable-font-lock ()
917    (or cperl-xemacs-p window-system))    cperl-can-font-lock)
918    
919  (defun cperl-putback-char (c)   ; Emacs 19  (defun cperl-putback-char (c)           ; Emacs 19
920    (set 'unread-command-events (list c))) ; Avoid undefined warning    (set 'unread-command-events (list c))) ; Avoid undefined warning
921    
922  (if (boundp 'unread-command-events)  (if (boundp 'unread-command-events)
# Line 955  the faces: please specify bold, italic, Line 970  the faces: please specify bold, italic,
970  ;;;     (setq interpreter-mode-alist (append interpreter-mode-alist  ;;;     (setq interpreter-mode-alist (append interpreter-mode-alist
971  ;;;                                       '(("miniperl" . perl-mode))))))  ;;;                                       '(("miniperl" . perl-mode))))))
972  (eval-when-compile  (eval-when-compile
973    (condition-case nil    (mapcar (lambda (p)
974        (require 'imenu)              (condition-case nil
975      (error nil))                  (require p)
976    (condition-case nil                (error nil)))
977        (require 'easymenu)            '(imenu easymenu etags timer man info))
     (error nil))  
   (condition-case nil  
       (require 'etags)  
     (error nil))  
   (condition-case nil  
       (require 'timer)  
     (error nil))  
   (condition-case nil  
       (require 'man)  
     (error nil))  
   (condition-case nil  
       (require 'info)  
     (error nil))  
978    (if (fboundp 'ps-extend-face-list)    (if (fboundp 'ps-extend-face-list)
979        (defmacro cperl-ps-extend-face-list (arg)        (defmacro cperl-ps-extend-face-list (arg)
980          `(ps-extend-face-list ,arg))          `(ps-extend-face-list ,arg))
# Line 1070  the faces: please specify bold, italic, Line 1072  the faces: please specify bold, italic,
1072  (condition-case nil  (condition-case nil
1073      (progn      (progn
1074        (require 'easymenu)        (require 'easymenu)
1075        (easy-menu-define cperl-menu cperl-mode-map "Menu for CPerl mode"        (easy-menu-define
1076           '("Perl"          cperl-menu cperl-mode-map "Menu for CPerl mode"
1077             ["Beginning of function" beginning-of-defun t]          '("Perl"
1078             ["End of function" end-of-defun t]            ["Beginning of function" beginning-of-defun t]
1079             ["Mark function" mark-defun t]            ["End of function" end-of-defun t]
1080             ["Indent expression" cperl-indent-exp t]            ["Mark function" mark-defun t]
1081             ["Fill paragraph/comment" cperl-fill-paragraph t]            ["Indent expression" cperl-indent-exp t]
1082             "----"            ["Fill paragraph/comment" cperl-fill-paragraph t]
1083             ["Line up a construction" cperl-lineup (cperl-use-region-p)]            "----"
1084             ["Invert if/unless/while etc" cperl-invert-if-unless t]            ["Line up a construction" cperl-lineup (cperl-use-region-p)]
1085             ("Regexp"            ["Invert if/unless/while etc" cperl-invert-if-unless t]
1086              ["Beautify" cperl-beautify-regexp            ("Regexp"
1087               cperl-use-syntax-table-text-property]             ["Beautify" cperl-beautify-regexp
1088              ["Beautify one level deep" (cperl-beautify-regexp 1)              cperl-use-syntax-table-text-property]
1089               cperl-use-syntax-table-text-property]             ["Beautify one level deep" (cperl-beautify-regexp 1)
1090              ["Beautify a group" cperl-beautify-level              cperl-use-syntax-table-text-property]
1091               cperl-use-syntax-table-text-property]             ["Beautify a group" cperl-beautify-level
1092              ["Beautify a group one level deep" (cperl-beautify-level 1)              cperl-use-syntax-table-text-property]
1093               cperl-use-syntax-table-text-property]             ["Beautify a group one level deep" (cperl-beautify-level 1)
1094              ["Contract a group" cperl-contract-level              cperl-use-syntax-table-text-property]
1095               cperl-use-syntax-table-text-property]             ["Contract a group" cperl-contract-level
1096              ["Contract groups" cperl-contract-levels              cperl-use-syntax-table-text-property]
1097               cperl-use-syntax-table-text-property])             ["Contract groups" cperl-contract-levels
1098             ["Refresh \"hard\" constructions" cperl-find-pods-heres t]              cperl-use-syntax-table-text-property])
1099             "----"            ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
1100             ["Indent region" cperl-indent-region (cperl-use-region-p)]            "----"
1101             ["Comment region" cperl-comment-region (cperl-use-region-p)]            ["Indent region" cperl-indent-region (cperl-use-region-p)]
1102             ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)]            ["Comment region" cperl-comment-region (cperl-use-region-p)]
1103             "----"            ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)]
1104             ["Run" mode-compile (fboundp 'mode-compile)]            "----"
1105             ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)            ["Run" mode-compile (fboundp 'mode-compile)]
1106                                            (get-buffer "*compilation*"))]            ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
1107             ["Next error" next-error (get-buffer "*compilation*")]                                           (get-buffer "*compilation*"))]
1108             ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]            ["Next error" next-error (get-buffer "*compilation*")]
1109             "----"            ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
1110             ["Debugger" cperl-db t]            "----"
1111             "----"            ["Debugger" cperl-db t]
1112             ("Tools"            "----"
1113              ["Imenu" imenu (fboundp 'imenu)]            ("Tools"
1114              ["Insert spaces if needed" cperl-find-bad-style t]             ["Imenu" imenu (fboundp 'imenu)]
1115              ["Class Hierarchy from TAGS" cperl-tags-hier-init t]             ["Insert spaces if needed" cperl-find-bad-style t]
1116              ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]             ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
1117              ["CPerl pretty print (exprmntl)" cperl-ps-print             ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
1118               (fboundp 'ps-extend-face-list)]             ["CPerl pretty print (exprmntl)" cperl-ps-print
1119              ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]              (fboundp 'ps-extend-face-list)]
1120              ("Tags"             ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]
1121               ("Tags"
1122  ;;;          ["Create tags for current file" cperl-etags t]  ;;;          ["Create tags for current file" cperl-etags t]
1123  ;;;          ["Add tags for current file" (cperl-etags t) t]  ;;;          ["Add tags for current file" (cperl-etags t) t]
1124  ;;;          ["Create tags for Perl files in directory" (cperl-etags nil t) t]  ;;;          ["Create tags for Perl files in directory" (cperl-etags nil t) t]
# Line 1125  the faces: please specify bold, italic, Line 1128  the faces: please specify bold, italic,
1128  ;;;          ["Add tags for Perl files in (sub)directories"  ;;;          ["Add tags for Perl files in (sub)directories"
1129  ;;;           (cperl-etags t 'recursive) t])  ;;;           (cperl-etags t 'recursive) t])
1130  ;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)  ;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)
1131               ["Create tags for current file" (cperl-write-tags nil t) t]              ["Create tags for current file" (cperl-write-tags nil t) t]
1132               ["Add tags for current file" (cperl-write-tags) t]              ["Add tags for current file" (cperl-write-tags) t]
1133               ["Create tags for Perl files in directory"              ["Create tags for Perl files in directory"
1134                (cperl-write-tags nil t nil t) t]               (cperl-write-tags nil t nil t) t]
1135               ["Add tags for Perl files in directory"              ["Add tags for Perl files in directory"
1136                (cperl-write-tags nil nil nil t) t]               (cperl-write-tags nil nil nil t) t]
1137               ["Create tags for Perl files in (sub)directories"              ["Create tags for Perl files in (sub)directories"
1138                (cperl-write-tags nil t t t) t]               (cperl-write-tags nil t t t) t]
1139               ["Add tags for Perl files in (sub)directories"              ["Add tags for Perl files in (sub)directories"
1140                (cperl-write-tags nil nil t t) t]))               (cperl-write-tags nil nil t t) t]))
1141             ("Perl docs"            ("Perl docs"
1142              ["Define word at point" imenu-go-find-at-position             ["Define word at point" imenu-go-find-at-position
1143               (fboundp 'imenu-go-find-at-position)]              (fboundp 'imenu-go-find-at-position)]
1144              ["Help on function" cperl-info-on-command t]             ["Help on function" cperl-info-on-command t]
1145              ["Help on function at point" cperl-info-on-current-command t]             ["Help on function at point" cperl-info-on-current-command t]
1146              ["Help on symbol at point" cperl-get-help t]             ["Help on symbol at point" cperl-get-help t]
1147              ["Perldoc" cperl-perldoc t]             ["Perldoc" cperl-perldoc t]
1148              ["Perldoc on word at point" cperl-perldoc-at-point t]             ["Perldoc on word at point" cperl-perldoc-at-point t]
1149              ["View manpage of POD in this file" cperl-pod-to-manpage t]             ["View manpage of POD in this file" cperl-pod-to-manpage t]
1150              ["Auto-help on" cperl-lazy-install             ["Auto-help on" cperl-lazy-install
1151               (and (fboundp 'run-with-idle-timer)              (and (fboundp 'run-with-idle-timer)
1152                    (not cperl-lazy-installed))]                   (not cperl-lazy-installed))]
1153              ["Auto-help off" (eval '(cperl-lazy-unstall))             ["Auto-help off" (eval '(cperl-lazy-unstall))
1154               (and (fboundp 'run-with-idle-timer)              (and (fboundp 'run-with-idle-timer)
1155                    cperl-lazy-installed)])                   cperl-lazy-installed)])
1156             ("Toggle..."            ("Toggle..."
1157              ["Auto newline" cperl-toggle-auto-newline t]             ["Auto newline" cperl-toggle-auto-newline t]
1158              ["Electric parens" cperl-toggle-electric t]             ["Electric parens" cperl-toggle-electric t]
1159              ["Electric keywords" cperl-toggle-abbrev t]             ["Electric keywords" cperl-toggle-abbrev t]
1160              ["Fix whitespace on indent" cperl-toggle-construct-fix t]             ["Fix whitespace on indent" cperl-toggle-construct-fix t]
1161              ["Auto fill" auto-fill-mode t])             ["Auto fill" auto-fill-mode t])
1162             ("Indent styles..."            ("Indent styles..."
1163              ["CPerl" (cperl-set-style "CPerl") t]             ["CPerl" (cperl-set-style "CPerl") t]
1164              ["PerlStyle" (cperl-set-style "PerlStyle") t]             ["PerlStyle" (cperl-set-style "PerlStyle") t]
1165              ["GNU" (cperl-set-style "GNU") t]             ["GNU" (cperl-set-style "GNU") t]
1166              ["C++" (cperl-set-style "C++") t]             ["C++" (cperl-set-style "C++") t]
1167              ["FSF" (cperl-set-style "FSF") t]             ["FSF" (cperl-set-style "FSF") t]
1168              ["BSD" (cperl-set-style "BSD") t]             ["BSD" (cperl-set-style "BSD") t]
1169              ["Whitesmith" (cperl-set-style "Whitesmith") t]             ["Whitesmith" (cperl-set-style "Whitesmith") t]
1170              ["Current" (cperl-set-style "Current") t]             ["Current" (cperl-set-style "Current") t]
1171              ["Memorized" (cperl-set-style-back) cperl-old-style])             ["Memorized" (cperl-set-style-back) cperl-old-style])
1172             ("Micro-docs"            ("Micro-docs"
1173              ["Tips" (describe-variable 'cperl-tips) t]             ["Tips" (describe-variable 'cperl-tips) t]
1174              ["Problems" (describe-variable 'cperl-problems) t]             ["Problems" (describe-variable 'cperl-problems) t]
1175              ["Speed" (describe-variable 'cperl-speed) t]             ["Speed" (describe-variable 'cperl-speed) t]
1176              ["Praise" (describe-variable 'cperl-praise) t]             ["Praise" (describe-variable 'cperl-praise) t]
1177              ["Faces" (describe-variable 'cperl-tips-faces) t]             ["Faces" (describe-variable 'cperl-tips-faces) t]
1178              ["CPerl mode" (describe-function 'cperl-mode) t]             ["CPerl mode" (describe-function 'cperl-mode) t]
1179              ["CPerl version"             ["CPerl version"
1180               (message "The version of master-file for this CPerl is %s-emacs"              (message "The version of master-file for this CPerl is %s-emacs"
1181                        cperl-version) t]))))                       cperl-version) t]))))
1182    (error nil))    (error nil))
1183    
1184  (autoload 'c-macro-expand "cmacexp"  (autoload 'c-macro-expand "cmacexp"
# Line 1224  The expansion is entirely correct becaus Line 1227  The expansion is entirely correct becaus
1227    (modify-syntax-entry ?| "." cperl-mode-syntax-table)    (modify-syntax-entry ?| "." cperl-mode-syntax-table)
1228    (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))    (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))
1229    (modify-syntax-entry ?$ "." cperl-string-syntax-table)    (modify-syntax-entry ?$ "." cperl-string-syntax-table)
1230    (modify-syntax-entry ?# "." cperl-string-syntax-table) ; (?# comment )    (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment )
 )  
1231    
1232    
1233    
1234  (defvar cperl-faces-init nil)  (defvar cperl-faces-init nil)
1235  ;; Fix for msb.el  ;; Fix for msb.el
1236  (defvar cperl-msb-fixed nil)  (defvar cperl-msb-fixed nil)
1237    (defvar cperl-use-major-mode 'cperl-mode)
1238    
1239  ;;;###autoload  ;;;###autoload
1240  (defun cperl-mode ()  (defun cperl-mode ()
1241    "Major mode for editing Perl code.    "Major mode for editing Perl code.
# Line 1337  beginning of the region at the start of Line 1341  beginning of the region at the start of
1341  span the needed amount of lines.  span the needed amount of lines.
1342    
1343  Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',  Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
1344  `cperl-pod-face', `cperl-pod-head-face' control processing of pod and  `cperl-pod-face', `cperl-pod-head-face' control processing of POD and
1345  here-docs sections.  With capable Emaxen results of scan are used  here-docs sections.  With capable Emaxen results of scan are used
1346  for indentation too, otherwise they are used for highlighting only.  for indentation too, otherwise they are used for highlighting only.
1347    
# Line 1412  or as help on variables `cperl-tips', `c Line 1416  or as help on variables `cperl-tips', `c
1416          (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])          (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
1417          (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command          (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command
1418                            [(control c) (control h) f])))                            [(control c) (control h) f])))
1419    (setq major-mode 'cperl-mode)    (setq major-mode cperl-use-major-mode)
1420    (setq mode-name "CPerl")    (setq mode-name "CPerl")
1421    (if (not cperl-mode-abbrev-table)    (if (not cperl-mode-abbrev-table)
1422        (let ((prev-a-c abbrevs-changed))        (let ((prev-a-c abbrevs-changed))
# Line 1502  or as help on variables `cperl-tips', `c Line 1506  or as help on variables `cperl-tips', `c
1506          ;; Fix broken font-lock:          ;; Fix broken font-lock:
1507          (or (boundp 'font-lock-unfontify-region-function)          (or (boundp 'font-lock-unfontify-region-function)
1508              (set 'font-lock-unfontify-region-function              (set 'font-lock-unfontify-region-function
1509                    'font-lock-default-unfontify-region))                   'font-lock-default-unfontify-region))
1510          (make-local-variable 'font-lock-unfontify-region-function)          (make-local-variable 'font-lock-unfontify-region-function)
1511          (set 'font-lock-unfontify-region-function          (set 'font-lock-unfontify-region-function ; not present with old Emacs
1512                'cperl-font-lock-unfontify-region-function)                'cperl-font-lock-unfontify-region-function)
1513          (make-local-variable 'cperl-syntax-done-to)          (make-local-variable 'cperl-syntax-done-to)
1514          ;; Another bug: unless font-lock-syntactic-keywords, font-lock          ;; Another bug: unless font-lock-syntactic-keywords, font-lock
# Line 1517  or as help on variables `cperl-tips', `c Line 1521  or as help on variables `cperl-tips', `c
1521                    '(t (cperl-fontify-syntaxically))                    '(t (cperl-fontify-syntaxically))
1522                  '(t)))))                  '(t)))))
1523    (make-local-variable 'cperl-old-style)    (make-local-variable 'cperl-old-style)
1524    (set (make-local-variable 'normal-auto-fill-function)    (if (boundp 'normal-auto-fill-function) ; 19.33 and later
1525         #'cperl-do-auto-fill)        (set (make-local-variable 'normal-auto-fill-function)
1526               'cperl-do-auto-fill)       ; RMS has it as #'cperl-do-auto-fill ???
1527        (or (fboundp 'cperl-old-auto-fill-mode)
1528            (progn
1529              (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
1530              (defun auto-fill-mode (&optional arg)
1531                (interactive "P")
1532                (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning
1533                (and auto-fill-function (memq major-mode '(perl-mode cperl-mode))
1534                     (setq auto-fill-function 'cperl-do-auto-fill))))))
1535    (if (cperl-enable-font-lock)    (if (cperl-enable-font-lock)
1536        (if (cperl-val 'cperl-font-lock)        (if (cperl-val 'cperl-font-lock)
1537            (progn (or cperl-faces-init (cperl-init-faces))            (progn (or cperl-faces-init (cperl-init-faces))
# Line 1531  or as help on variables `cperl-tips', `c Line 1544  or as help on variables `cperl-tips', `c
1544    (run-hooks 'cperl-mode-hook)    (run-hooks 'cperl-mode-hook)
1545    ;; After hooks since fontification will break this    ;; After hooks since fontification will break this
1546    (if cperl-pod-here-scan    (if cperl-pod-here-scan
1547        (or ;;(and (boundp 'font-lock-mode)        (or cperl-syntaxify-by-font-lock
           ;;     (eval 'font-lock-mode) ; Avoid warning  
           ;;     (boundp 'font-lock-hot-pass) ; Newer font-lock  
        cperl-syntaxify-by-font-lock  ;;)  
1548         (progn (or cperl-faces-init (cperl-init-faces-weak))         (progn (or cperl-faces-init (cperl-init-faces-weak))
1549                (cperl-find-pods-heres)))))                (cperl-find-pods-heres)))))
1550    
# Line 1546  or as help on variables `cperl-tips', `c Line 1556  or as help on variables `cperl-tips', `c
1556                                  (if (consp gud-perldb-history)                                  (if (consp gud-perldb-history)
1557                                      (car gud-perldb-history)                                      (car gud-perldb-history)
1558                                    (concat "perl " ;;(file-name-nondirectory                                    (concat "perl " ;;(file-name-nondirectory
1559                                                     ;; I have problems                                            ;; I have problems
1560                                                     ;; in OS/2                                            ;; in OS/2
1561                                                     ;; otherwise                                            ;; otherwise
1562                                                     (buffer-file-name)))                                            (buffer-file-name)))
1563                                  nil nil                                  nil nil
1564                                  '(gud-perldb-history . 1))))                                  '(gud-perldb-history . 1))))
1565    
# Line 1675  char is \"{\", insert extra newline befo Line 1685  char is \"{\", insert extra newline befo
1685              (setq last-command-char ?\{)              (setq last-command-char ?\{)
1686              (cperl-electric-lbrace arg insertpos))              (cperl-electric-lbrace arg insertpos))
1687            (forward-char 1))            (forward-char 1))
1688        ;: Check whether we close something "usual" with `}'        ;; Check whether we close something "usual" with `}'
1689        (if (and (eq last-command-char ?\})        (if (and (eq last-command-char ?\})
1690                 (not                 (not
1691                  (condition-case nil                  (condition-case nil
# Line 1725  char is \"{\", insert extra newline befo Line 1735  char is \"{\", insert extra newline befo
1735  (defun cperl-electric-lbrace (arg &optional end)  (defun cperl-electric-lbrace (arg &optional end)
1736    "Insert character, correct line's indentation, correct quoting by space."    "Insert character, correct line's indentation, correct quoting by space."
1737    (interactive "P")    (interactive "P")
1738    (let (pos after    (let ((cperl-brace-recursing t)
1739              (cperl-brace-recursing t)          (cperl-auto-newline cperl-auto-newline)
1740              (cperl-auto-newline cperl-auto-newline)          (other-end (or end
1741              (other-end (or end                         (if (and cperl-electric-parens-mark
1742                             (if (and cperl-electric-parens-mark                                  (cperl-mark-active)
1743                                      (cperl-mark-active)                                  (> (mark) (point)))
1744                                      (> (mark) (point)))                             (save-excursion
1745                                 (save-excursion                               (goto-char (mark))
1746                                   (goto-char (mark))                               (point-marker))
1747                                   (point-marker))                           nil)))
1748                               nil))))          pos after)
1749      (and (cperl-val 'cperl-electric-lbrace-space)      (and (cperl-val 'cperl-electric-lbrace-space)
1750           (eq (preceding-char) ?$)           (eq (preceding-char) ?$)
1751           (save-excursion           (save-excursion
# Line 1768  char is \"{\", insert extra newline befo Line 1778  char is \"{\", insert extra newline befo
1778          (other-end (if (and cperl-electric-parens-mark          (other-end (if (and cperl-electric-parens-mark
1779                              (cperl-mark-active)                              (cperl-mark-active)
1780                              (> (mark) (point)))                              (> (mark) (point)))
1781                             (save-excursion                         (save-excursion
1782                               (goto-char (mark))                           (goto-char (mark))
1783                               (point-marker))                           (point-marker))
1784                       nil)))                       nil)))
1785      (if (and (cperl-val 'cperl-electric-parens)      (if (and (cperl-val 'cperl-electric-parens)
1786               (memq last-command-char               (memq last-command-char
# Line 1822  If not, or if we are not at the end of m Line 1832  If not, or if we are not at the end of m
1832            (insert (make-string            (insert (make-string
1833                     (prefix-numeric-value arg)                     (prefix-numeric-value arg)
1834                     (cdr (assoc last-command-char '((?\} . ?\{)                     (cdr (assoc last-command-char '((?\} . ?\{)
1835                                                    (?\] . ?\[)                                                     (?\] . ?\[)
1836                                                    (?\) . ?\()                                                     (?\) . ?\()
1837                                                    (?\> . ?\<))))))                                                     (?\> . ?\<))))))
1838            (goto-char (1+ p)))            (goto-char (1+ p)))
1839        (self-insert-command (prefix-numeric-value arg)))))        (self-insert-command (prefix-numeric-value arg)))))
1840    
# Line 1879  to nil." Line 1889  to nil."
1889               (insert "\n}")               (insert "\n}")
1890               (and do (insert " while ();")))               (and do (insert " while ();")))
1891              (t              (t
1892               (insert (if do " {\n} while ();" " () {\n}")))               (insert (if do " {\n} while ();" " () {\n}"))))
             )  
1893             (or (looking-at "[ \t]\\|$") (insert " "))             (or (looking-at "[ \t]\\|$") (insert " "))
1894             (cperl-indent-line)             (cperl-indent-line)
1895             (if dollar (progn (search-backward "$")             (if dollar (progn (search-backward "$")
# Line 1943  to nil." Line 1952  to nil."
1952                             (save-excursion                             (save-excursion
1953                               (forward-char -1)                               (forward-char -1)
1954                               (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>"                               (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>"
1955                                                  nil t)))) ; Only one                                                   nil t)))) ; Only one
1956                       (progn                       (progn
1957                         (forward-word 1)                         (forward-word 1)
1958                         (setq name (file-name-sans-extension                         (setq name (file-name-sans-extension
# Line 2000  to nil." Line 2009  to nil."
2009               (cperl-indent-line)               (cperl-indent-line)
2010               (insert "\n\n}"))               (insert "\n\n}"))
2011              (t              (t
2012               (insert " {\n\n}"))               (insert " {\n\n}")))
             )  
2013             (or (looking-at "[ \t]\\|$") (insert " "))             (or (looking-at "[ \t]\\|$") (insert " "))
2014             (cperl-indent-line)             (cperl-indent-line)
2015             (forward-line -1)             (forward-line -1)
# Line 2021  If in POD, insert appropriate lines." Line 2029  If in POD, insert appropriate lines."
2029      (if (and                            ; Check if we need to split:      (if (and                            ; Check if we need to split:
2030                                          ; i.e., on a boundary and inside "{...}"                                          ; i.e., on a boundary and inside "{...}"
2031           (save-excursion (cperl-to-comment-or-eol)           (save-excursion (cperl-to-comment-or-eol)
2032             (>= (point) pos))            ; Not in a comment                           (>= (point) pos)) ; Not in a comment
2033           (or (save-excursion           (or (save-excursion
2034                 (skip-chars-backward " \t" beg)                 (skip-chars-backward " \t" beg)
2035                 (forward-char -1)                 (forward-char -1)
# Line 2058  If in POD, insert appropriate lines." Line 2066  If in POD, insert appropriate lines."
2066            (cperl-indent-line)            (cperl-indent-line)
2067            (beginning-of-line)            (beginning-of-line)
2068            (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement            (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement
2069                                              ; after, move it to separate line                                          ; after, move it to separate line
2070                (progn                (progn
2071                  (end-of-line)                  (end-of-line)
2072                  (search-backward "}" beg)                  (search-backward "}" beg)
# Line 2077  If in POD, insert appropriate lines." Line 2085  If in POD, insert appropriate lines."
2085               (save-excursion               (save-excursion
2086                 (skip-chars-backward " \t")                 (skip-chars-backward " \t")
2087                 (eq (preceding-char) ?\)))) ; Probably if () {} group                 (eq (preceding-char) ?\)))) ; Probably if () {} group
2088                                             ; with an extra newline.                                          ; with an extra newline.
2089          (forward-line 2)          (forward-line 2)
2090          (cperl-indent-line))          (cperl-indent-line))
2091         ((save-excursion                 ; In POD header         ((save-excursion                 ; In POD header
# Line 2129  If in POD, insert appropriate lines." Line 2137  If in POD, insert appropriate lines."
2137  (defun cperl-electric-terminator (arg)  (defun cperl-electric-terminator (arg)
2138    "Insert character and correct line's indentation."    "Insert character and correct line's indentation."
2139    (interactive "P")    (interactive "P")
2140    (let (insertpos (end (point))    (let ((end (point))
2141                    (auto (and cperl-auto-newline          (auto (and cperl-auto-newline
2142                               (or (not (eq last-command-char ?:))                     (or (not (eq last-command-char ?:))
2143                                   cperl-auto-newline-after-colon))))                         cperl-auto-newline-after-colon)))
2144            insertpos)
2145      (if (and ;;(not arg)      (if (and ;;(not arg)
2146               (eolp)               (eolp)
2147               (not (save-excursion               (not (save-excursion
# Line 2251  The relative indentation among the lines Line 2260  The relative indentation among the lines
2260  (defun cperl-indent-line (&optional parse-data)  (defun cperl-indent-line (&optional parse-data)
2261    "Indent current line as Perl code.    "Indent current line as Perl code.
2262  Return the amount the indentation changed by."  Return the amount the indentation changed by."
2263    (let (indent i beg shift-amt    (let ((case-fold-search nil)
2264          (case-fold-search nil)          (pos (- (point-max) (point)))
2265          (pos (- (point-max) (point))))          indent i beg shift-amt)
2266      (setq indent (cperl-calculate-indent parse-data)      (setq indent (cperl-calculate-indent parse-data)
2267            i indent)            i indent)
2268      (beginning-of-line)      (beginning-of-line)
# Line 2331  Return the amount the indentation change Line 2340  Return the amount the indentation change
2340        (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))        (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
2341        (list start state depth prestart))))        (list start state depth prestart))))
2342    
2343  (defun cperl-block-p ()                 ; Do not C-M-q !  One string contains ";" !  (defun cperl-block-p ()            ; Do not C-M-q !  One string contains ";" !
2344    ;; Positions is before ?\{.  Checks whether it starts a block.    ;; Positions is before ?\{.  Checks whether it starts a block.
2345    ;; No save-excursion!    ;; No save-excursion!
2346    (cperl-backward-to-noncomment (point-min))    (cperl-backward-to-noncomment (point-min))
# Line 2368  and closing parentheses and brackets." Line 2377  and closing parentheses and brackets."
2377                (not (get-text-property (point) 'indentable)))                (not (get-text-property (point) 'indentable)))
2378           ;; before start of POD - whitespace found since do not have 'pod!           ;; before start of POD - whitespace found since do not have 'pod!
2379           (and (looking-at "[ \t]*\n=")           (and (looking-at "[ \t]*\n=")
2380                (error "Spaces before pod section!"))                (error "Spaces before POD section!"))
2381           (and (not cperl-indent-left-aligned-comments)           (and (not cperl-indent-left-aligned-comments)
2382                (looking-at "^#")))                (looking-at "^#")))
2383          nil          nil
2384       (beginning-of-line)        (beginning-of-line)
2385       (let ((indent-point (point))        (let ((indent-point (point))
2386             (char-after (save-excursion              (char-after (save-excursion
2387                             (skip-chars-forward " \t")                            (skip-chars-forward " \t")
2388                             (following-char)))                            (following-char)))
2389             (in-pod (get-text-property (point) 'in-pod))              (in-pod (get-text-property (point) 'in-pod))
2390             (pre-indent-point (point))              (pre-indent-point (point))
2391             p prop look-prop is-block delim)              p prop look-prop is-block delim)
2392        (cond          (cond
2393         (in-pod           (in-pod
2394          ;; In the verbatim part, probably code example.  What to do???            ;; In the verbatim part, probably code example.  What to do???
2395          )            )
2396         (t           (t
2397          (save-excursion            (save-excursion
2398            ;; Not in pod              ;; Not in POD
2399            (cperl-backward-to-noncomment nil)              (cperl-backward-to-noncomment nil)
2400            (setq p (max (point-min) (1- (point)))              (setq p (max (point-min) (1- (point)))
2401                  prop (get-text-property p 'syntax-type)                    prop (get-text-property p 'syntax-type)
2402                  look-prop (or (nth 1 (assoc prop cperl-look-for-prop))                    look-prop (or (nth 1 (assoc prop cperl-look-for-prop))
2403                                'syntax-type))                                  'syntax-type))
2404            (if (memq prop '(pod here-doc format here-doc-delim))              (if (memq prop '(pod here-doc format here-doc-delim))
2405                    (progn
2406                      (goto-char (or (previous-single-property-change p look-prop)
2407                                     (point-min)))
2408                      (beginning-of-line)
2409                      (setq pre-indent-point (point)))))))
2410            (goto-char pre-indent-point)
2411            (let* ((case-fold-search nil)
2412                   (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
2413                   (start (or (nth 2 parse-data)
2414                              (nth 0 s-s)))
2415                   (state (nth 1 s-s))
2416                   (containing-sexp (car (cdr state)))
2417                   old-indent)
2418              (if (and
2419                   ;;containing-sexp                ;; We are buggy at toplevel :-(
2420                   parse-data)
2421                (progn                (progn
2422                  (goto-char (or (previous-single-property-change p look-prop)                  (setcar parse-data pre-indent-point)
2423                                 (point-min)))                  (setcar (cdr parse-data) state)
2424                  (beginning-of-line)                  (or (nth 2 parse-data)
2425                  (setq pre-indent-point (point)))))))                      (setcar (cddr parse-data) start))
2426        (goto-char pre-indent-point)                  ;; Before this point: end of statement
2427        (let* ((case-fold-search nil)                  (setq old-indent (nth 3 parse-data))))
2428               (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))            (cond ((get-text-property (point) 'indentable)
2429               (start (or (nth 2 parse-data)                   ;; indent to just after the surrounding open,
2430                          (nth 0 s-s)))                   ;; skip blanks if we do not close the expression.
2431               (state (nth 1 s-s))                   (goto-char (1+ (previous-single-property-change (point) 'indentable)))
2432               (containing-sexp (car (cdr state)))                   (or (memq char-after (append ")]}" nil))
2433               old-indent)                       (looking-at "[ \t]*\\(#\\|$\\)")
2434          (if (and                       (skip-chars-forward " \t"))
2435               ;;containing-sexp          ;; We are buggy at toplevel :-(                   (current-column))
2436               parse-data)                  ((or (nth 3 state) (nth 4 state))
2437              (progn                   ;; return nil or t if should not change this line
2438                (setcar parse-data pre-indent-point)                   (nth 4 state))
2439                (setcar (cdr parse-data) state)                  ;; XXXX Do we need to special-case this?
2440                (or (nth 2 parse-data)                  ((null containing-sexp)
2441                    (setcar (cddr parse-data) start))                   ;; Line is at top level.  May be data or function definition,
2442                ;; Before this point: end of statement                   ;; or may be function argument declaration.
2443                (setq old-indent (nth 3 parse-data))))                   ;; Indent like the previous top level line
2444          (cond ((get-text-property (point) 'indentable)                   ;; unless that ends in a closeparen without semicolon,
2445                 ;; indent to just after the surrounding open,                   ;; in which case this line is the first argument decl.
2446                 ;; skip blanks if we do not close the expression.                   (skip-chars-forward " \t")
2447                 (goto-char (1+ (previous-single-property-change (point) 'indentable)))                   (+ (save-excursion
2448                 (or (memq char-after (append ")]}" nil))                        (goto-char start)
2449                     (looking-at "[ \t]*\\(#\\|$\\)")                        (- (current-indentation)
2450                     (skip-chars-forward " \t"))                           (if (nth 2 s-s) cperl-indent-level 0)))
2451                 (current-column))                      (if (= char-after ?{) cperl-continued-brace-offset 0)
2452                ((or (nth 3 state) (nth 4 state))                      (progn
2453                 ;; return nil or t if should not change this line                        (cperl-backward-to-noncomment (or old-indent (point-min)))
2454                 (nth 4 state))                        ;; Look at previous line that's at column 0
2455                ;; XXXX Do we need to special-case this?                        ;; to determine whether we are in top-level decls
2456                ((null containing-sexp)                        ;; or function's arg decls.  Set basic-indent accordingly.
2457                 ;; Line is at top level.  May be data or function definition,                        ;; Now add a little if this is a continuation line.
2458                 ;; or may be function argument declaration.                        (if (or (bobp)
2459                 ;; Indent like the previous top level line                                (eq (point) old-indent) ; old-indent was at comment
2460                 ;; unless that ends in a closeparen without semicolon,                                (eq (preceding-char) ?\;)
2461                 ;; in which case this line is the first argument decl.                                ;;  Had ?\) too
2462                 (skip-chars-forward " \t")                                (and (eq (preceding-char) ?\})
2463                 (+ (save-excursion                                     (cperl-after-block-and-statement-beg
2464                      (goto-char start)                                      (point-min))) ; Was start - too close
2465                      (- (current-indentation)                                (memq char-after (append ")]}" nil))
2466                         (if (nth 2 s-s) cperl-indent-level 0)))                                (and (eq (preceding-char) ?\:) ; label
2467                    (if (= char-after ?{) cperl-continued-brace-offset 0)                                     (progn
2468                    (progn                                       (forward-sexp -1)
2469                      (cperl-backward-to-noncomment (or old-indent (point-min)))                                       (skip-chars-backward " \t")
2470                      ;; Look at previous line that's at column 0                                       (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))))
2471                      ;; to determine whether we are in top-level decls                            (progn
2472                      ;; or function's arg decls.  Set basic-indent accordingly.                              (if (and parse-data
2473                      ;; Now add a little if this is a continuation line.                                       (not (eq char-after ?\C-j)))
2474                      (if (or (bobp)                                  (setcdr (cddr parse-data)
2475                              (eq (point) old-indent) ; old-indent was at comment                                          (list pre-indent-point)))
2476                              (eq (preceding-char) ?\;)                              0)
2477                              ;;  Had ?\) too                          cperl-continued-statement-offset))))
2478                              (and (eq (preceding-char) ?\})                  ((not
2479                                   (cperl-after-block-and-statement-beg                    (or (setq is-block
2480                                    (point-min))) ; Was start - too close                              (and (setq delim (= (char-after containing-sexp) ?{))
2481                              (memq char-after (append ")]}" nil))                                   (save-excursion ; Is it a hash?
2482                              (and (eq (preceding-char) ?\:) ; label                                     (goto-char containing-sexp)
2483                                   (progn                                     (cperl-block-p))))
2484                                     (forward-sexp -1)                        cperl-indent-parens-as-block))
2485                                     (skip-chars-backward " \t")                   ;; group is an expression, not a block:
2486                                     (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))))                   ;; indent to just after the surrounding open parens,
2487                          (progn                   ;; skip blanks if we do not close the expression.
2488                            (if (and parse-data                   (goto-char (1+ containing-sexp))
2489                                     (not (eq char-after ?\C-j)))                   (or (memq char-after
2490                                (setcdr (cddr parse-data)                             (append (if delim "}" ")]}") nil))
2491                                        (list pre-indent-point)))                       (looking-at "[ \t]*\\(#\\|$\\)")
2492                            0)                       (skip-chars-forward " \t"))
2493                        cperl-continued-statement-offset))))                   (+ (current-column)
2494                ((not                      (if (and delim
2495                  (or (setq is-block                               (eq char-after ?\}))
2496                            (and (setq delim (= (char-after containing-sexp) ?{))                          ;; Correct indentation of trailing ?\}
2497                                 (save-excursion ; Is it a hash?                          (+ cperl-indent-level cperl-close-paren-offset)
2498                                   (goto-char containing-sexp)                        0)))
                                  (cperl-block-p))))  
                     cperl-indent-parens-as-block))  
                ;; group is an expression, not a block:  
                ;; indent to just after the surrounding open parens,  
                ;; skip blanks if we do not close the expression.  
                (goto-char (1+ containing-sexp))  
                (or (memq char-after (append ")]}" nil))  
                    (looking-at "[ \t]*\\(#\\|$\\)")  
                    (skip-chars-forward " \t"))  
                (current-column))  
               ((progn  
                  ;; Containing-expr starts with \{.  Check whether it is a hash.  
                  (goto-char containing-sexp)  
                  (not (cperl-block-p)))  
                (goto-char (1+ containing-sexp))  
                (or (memq char-after  
                          (append (if delim "}" ")]}") nil))  
                    (looking-at "[ \t]*\\(#\\|$\\)")  
                    (skip-chars-forward " \t"))  
                (+ (current-column)  
                   (if (and delim  
                            (eq char-after ?\}))  
                       ;; Correct indentation of trailing ?\}  
                       (+ cperl-indent-level cperl-close-paren-offset)  
                     0)))  
2499  ;;;           ((and (/= (char-after containing-sexp) ?{)  ;;;           ((and (/= (char-after containing-sexp) ?{)
2500  ;;;                 (not cperl-indent-parens-as-block))  ;;;                 (not cperl-indent-parens-as-block))
2501  ;;;            ;; line is expression, not statement:  ;;;            ;; line is expression, not statement:
# Line 2519  and closing parentheses and brackets." Line 2519  and closing parentheses and brackets."
2519  ;;;               (if (eq char-after ?\}) (+ cperl-indent-level  ;;;               (if (eq char-after ?\}) (+ cperl-indent-level
2520  ;;;                                          cperl-close-paren-offset)  ;;;                                          cperl-close-paren-offset)
2521  ;;;                 0)))  ;;;                 0)))
2522                (t                  (t
2523                 ;; Statement level.  Is it a continuation or a new statement?                   ;; Statement level.  Is it a continuation or a new statement?
2524                 ;; Find previous non-comment character.                   ;; Find previous non-comment character.
2525                 (goto-char pre-indent-point)                   (goto-char pre-indent-point)
2526                 (cperl-backward-to-noncomment containing-sexp)                   (cperl-backward-to-noncomment containing-sexp)
2527                 ;; Back up over label lines, since they don't                   ;; Back up over label lines, since they don't
2528                 ;; affect whether our line is a continuation.                   ;; affect whether our line is a continuation.
2529                 ;; (Had \, too)                   ;; (Had \, too)
2530                 (while ;;(or (eq (preceding-char) ?\,)                   (while ;;(or (eq (preceding-char) ?\,)
2531                            (and (eq (preceding-char) ?:)                       (and (eq (preceding-char) ?:)
2532                                 (or;;(eq (char-after (- (point) 2)) ?\') ; ????                            (or ;;(eq (char-after (- (point) 2)) ?\') ; ????
2533                                  (memq (char-syntax (char-after (- (point) 2)))                             (memq (char-syntax (char-after (- (point) 2)))
2534                                        '(?w ?_))))                                   '(?w ?_))))
2535                            ;;)                     ;;)
2536                   (if (eq (preceding-char) ?\,)                     (if (eq (preceding-char) ?\,)
2537                       ;; Will go to beginning of line, essentially.                         ;; Will go to beginning of line, essentially.
2538                       ;; Will ignore embedded sexpr XXXX.                         ;; Will ignore embedded sexpr XXXX.
2539                       (cperl-backward-to-start-of-continued-exp containing-sexp))                         (cperl-backward-to-start-of-continued-exp containing-sexp))
2540                   (beginning-of-line)                     (beginning-of-line)
2541                   (cperl-backward-to-noncomment containing-sexp))                     (cperl-backward-to-noncomment containing-sexp))
2542                 ;; Now we get the answer.                   ;; Now we get the answer.
2543                 (if (not (or (eq (1- (point)) containing-sexp)                   (if (not (or (eq (1- (point)) containing-sexp)
2544                              (memq (preceding-char)                                (memq (preceding-char)
2545                                    (append (if is-block " ;{" " ,;{") '(nil)))                                      (append (if is-block " ;{" " ,;{") '(nil)))
2546                              (and (eq (preceding-char) ?\})                                (and (eq (preceding-char) ?\})
2547                                   (cperl-after-block-and-statement-beg                                     (cperl-after-block-and-statement-beg
2548                                    containing-sexp))))                                      containing-sexp))))
2549                     ;; This line is continuation of preceding line's statement;                       ;; This line is continuation of preceding line's statement;
2550                     ;; indent  `cperl-continued-statement-offset'  more than the                       ;; indent  `cperl-continued-statement-offset'  more than the
2551                     ;; previous line of the statement.                       ;; previous line of the statement.
2552                     ;;                       ;;
2553                     ;; There might be a label on this line, just                       ;; There might be a label on this line, just
2554                     ;; consider it bad style and ignore it.                       ;; 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)  
                         (if (or is-block  
                                 (not delim)  
                                 (not (eq char-after ?\})))  
                             0  
                           ;; Now it is a hash reference  
                           (+ cperl-indent-level cperl-close-paren-offset))  
                         (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.  
                  ;; Position following last unclosed open.  
                  (goto-char containing-sexp)  
                  ;; Is line first statement after an open-brace?  
                  (or  
                   ;; If no, find that first statement and indent like  
                   ;; it.  If the first statement begins with label, do  
                   ;; not believe when the indentation of the label is too  
                   ;; small.  
                   (save-excursion  
                     (forward-char 1)  
                     (setq old-indent (current-indentation))  
                     (let ((colon-line-end 0))  
                       (while (progn (skip-chars-forward " \t\n")  
                                     (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]"))  
                         ;; Skip over comments and labels following openbrace.  
                         (cond ((= (following-char) ?\#)  
                                (forward-line 1))  
                               ;; label:  
                               (t  
                                (save-excursion (end-of-line)  
                                                (setq colon-line-end (point)))  
                                (search-forward ":"))))  
                       ;; The first following code counts  
                       ;; if it is before the line we want to indent.  
                       (and (< (point) indent-point)  
                            (if (> colon-line-end (point)) ; After label  
                                (if (> (current-indentation)  
                                       cperl-min-label-indent)  
                                    (- (current-indentation) cperl-label-offset)  
                                  ;; Do not believe: `max' is involved  
                                  (+ old-indent cperl-indent-level))  
                              (current-column)))))  
                   ;; If no previous statement,  
                   ;; indent it relative to line brace is on.  
                   ;; For open brace in column zero, don't let statement  
                   ;; start there too.  If cperl-indent-level is zero,  
                   ;; use cperl-brace-offset + cperl-continued-statement-offset instead.  
                   ;; For open-braces not the first thing in a line,  
                   ;; add in cperl-brace-imaginary-offset.  
   
                   ;; If first thing on a line:  ?????  
                   (+ (if (and (bolp) (zerop cperl-indent-level))  
                          (+ cperl-brace-offset cperl-continued-statement-offset)  
                        cperl-indent-level)  
                      (if (or is-block  
                              (not delim)  
                              (not (eq char-after ?\})))  
                          0  
                        ;; Now it is a hash reference  
                        (+ cperl-indent-level cperl-close-paren-offset))  
                      ;; Move back over whitespace before the openbrace.  
                      ;; If openbrace is not first nonwhite thing on the line,  
                      ;; add the cperl-brace-imaginary-offset.  
                      (progn (skip-chars-backward " \t")  
                             (if (bolp) 0 cperl-brace-imaginary-offset))  
                      ;; If the openbrace is preceded by a parenthesized exp,  
                      ;; move to the beginning of that;  
                      ;; possibly a different line  
2555                       (progn                       (progn
2556                         (if (eq (preceding-char) ?\))                         (cperl-backward-to-start-of-continued-exp containing-sexp)
2557                             (forward-sexp -1))                         (+ (if (memq char-after (append "}])" nil))
2558                         ;; In the case it starts a subroutine, indent with                                0         ; Closing parenth
2559                         ;; respect to `sub', not with respect to the                              cperl-continued-statement-offset)
2560                         ;; first thing on the line, say in the case of                            (if (or is-block
2561                         ;; anonymous sub in a hash.                                    (not delim)
2562                         ;;                                    (not (eq char-after ?\})))
2563                         (skip-chars-backward " \t")                                0
2564                         (if (and (eq (preceding-char) ?b)                              ;; Now it is a hash reference
2565                                  (progn                              (+ cperl-indent-level cperl-close-paren-offset))
2566                                    (forward-sexp -1)                            (if (looking-at "\\w+[ \t]*:")
2567                                    (looking-at "sub\\>"))                                (if (> (current-indentation) cperl-min-label-indent)
2568                                  (setq old-indent                                    (- (current-indentation) cperl-label-offset)
2569                                        (nth 1                                  ;; Do not move `parse-data', this should
2570                                             (parse-partial-sexp                                  ;; be quick anyway (this comment comes
2571                                              (save-excursion (beginning-of-line) (point))                                  ;; from different location):
2572                                              (point)))))                                  (cperl-calculate-indent))
2573                             (progn (goto-char (1+ old-indent))                              (current-column))
2574                                    (skip-chars-forward " \t")                            (if (eq char-after ?\{)
2575                                    (current-column))                                cperl-continued-brace-offset 0)))
2576                           ;; Get initial indentation of the line we are on.                     ;; This line starts a new statement.
2577                           ;; If line starts with label, calculate label indentation                     ;; Position following last unclosed open.
2578                           (if (save-excursion                     (goto-char containing-sexp)
2579                                 (beginning-of-line)                     ;; Is line first statement after an open-brace?
2580                                 (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))                     (or
2581                               (if (> (current-indentation) cperl-min-label-indent)                      ;; If no, find that first statement and indent like
2582                                   (- (current-indentation) cperl-label-offset)                      ;; it.  If the first statement begins with label, do
2583                                 ;; Do not move `parse-data', this should                      ;; not believe when the indentation of the label is too
2584                                 ;; be quick anyway:                      ;; small.
2585                                 (cperl-calculate-indent))                      (save-excursion
2586                             (current-indentation))))))))))))))                        (forward-char 1)
2587                          (setq old-indent (current-indentation))
2588                          (let ((colon-line-end 0))
2589                            (while (progn (skip-chars-forward " \t\n")
2590                                          (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]"))
2591                              ;; Skip over comments and labels following openbrace.
2592                              (cond ((= (following-char) ?\#)
2593                                     (forward-line 1))
2594                                    ;; label:
2595                                    (t
2596                                     (save-excursion (end-of-line)
2597                                                     (setq colon-line-end (point)))
2598                                     (search-forward ":"))))
2599                            ;; The first following code counts
2600                            ;; if it is before the line we want to indent.
2601                            (and (< (point) indent-point)
2602                                 (if (> colon-line-end (point)) ; After label
2603                                     (if (> (current-indentation)
2604                                            cperl-min-label-indent)
2605                                         (- (current-indentation) cperl-label-offset)
2606                                       ;; Do not believe: `max' is involved
2607                                       (+ old-indent cperl-indent-level))
2608                                   (current-column)))))
2609                        ;; If no previous statement,
2610                        ;; indent it relative to line brace is on.
2611                        ;; For open brace in column zero, don't let statement
2612                        ;; start there too.  If cperl-indent-level is zero,
2613                        ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
2614                        ;; For open-braces not the first thing in a line,
2615                        ;; add in cperl-brace-imaginary-offset.
2616    
2617                        ;; If first thing on a line:  ?????
2618                        (+ (if (and (bolp) (zerop cperl-indent-level))
2619                               (+ cperl-brace-offset cperl-continued-statement-offset)
2620                             cperl-indent-level)
2621                           (if (or is-block
2622                                   (not delim)
2623                                   (not (eq char-after ?\})))
2624                               0
2625                             ;; Now it is a hash reference
2626                             (+ cperl-indent-level cperl-close-paren-offset))
2627                           ;; Move back over whitespace before the openbrace.
2628                           ;; If openbrace is not first nonwhite thing on the line,
2629                           ;; add the cperl-brace-imaginary-offset.
2630                           (progn (skip-chars-backward " \t")
2631                                  (if (bolp) 0 cperl-brace-imaginary-offset))
2632                           ;; If the openbrace is preceded by a parenthesized exp,
2633                           ;; move to the beginning of that;
2634                           ;; possibly a different line
2635                           (progn
2636                             (if (eq (preceding-char) ?\))
2637                                 (forward-sexp -1))
2638                             ;; In the case it starts a subroutine, indent with
2639                             ;; respect to `sub', not with respect to the
2640                             ;; first thing on the line, say in the case of
2641                             ;; anonymous sub in a hash.
2642                             ;;
2643                             (skip-chars-backward " \t")
2644                             (if (and (eq (preceding-char) ?b)
2645                                      (progn
2646                                        (forward-sexp -1)
2647                                        (looking-at "sub\\>"))
2648                                      (setq old-indent
2649                                            (nth 1
2650                                                 (parse-partial-sexp
2651                                                  (save-excursion (beginning-of-line) (point))
2652                                                  (point)))))
2653                                 (progn (goto-char (1+ old-indent))
2654                                        (skip-chars-forward " \t")
2655                                        (current-column))
2656                               ;; Get initial indentation of the line we are on.
2657                               ;; If line starts with label, calculate label indentation
2658                               (if (save-excursion
2659                                     (beginning-of-line)
2660                                     (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
2661                                   (if (> (current-indentation) cperl-min-label-indent)
2662                                       (- (current-indentation) cperl-label-offset)
2663                                     ;; Do not move `parse-data', this should
2664                                     ;; be quick anyway:
2665                                     (cperl-calculate-indent))
2666                                 (current-indentation))))))))))))))
2667    
2668  (defvar cperl-indent-alist  (defvar cperl-indent-alist
2669    '((string nil)    '((string nil)
# Line 2725  Not finished, not used." Line 2725  Not finished, not used."
2725                                       (point)))                                       (point)))
2726                               (cons (list 'expression containing-sexp) res))))                               (cons (list 'expression containing-sexp) res))))
2727              ((progn              ((progn
2728                ;; Containing-expr starts with \{.  Check whether it is a hash.                 ;; Containing-expr starts with \{.  Check whether it is a hash.
2729                (goto-char containing-sexp)                 (goto-char containing-sexp)
2730                (not (cperl-block-p)))                 (not (cperl-block-p)))
2731               (setq res (cons (list 'expression-blanks               (setq res (cons (list 'expression-blanks
2732                                     (progn                                     (progn
2733                                       (goto-char (1+ containing-sexp))                                       (goto-char (1+ containing-sexp))
# Line 2748  Not finished, not used." Line 2748  Not finished, not used."
2748                          (save-excursion (cperl-after-label)))                          (save-excursion (cperl-after-label)))
2749                 (if (eq (preceding-char) ?\,)                 (if (eq (preceding-char) ?\,)
2750                     ;; Will go to beginning of line, essentially                     ;; Will go to beginning of line, essentially
2751                       ;; Will ignore embedded sexpr XXXX.                     ;; Will ignore embedded sexpr XXXX.
2752                     (cperl-backward-to-start-of-continued-exp containing-sexp))                     (cperl-backward-to-start-of-continued-exp containing-sexp))
2753                 (beginning-of-line)                 (beginning-of-line)
2754                 (cperl-backward-to-noncomment containing-sexp))                 (cperl-backward-to-noncomment containing-sexp))
# Line 2848  the current line is to be regarded as pa Line 2848  the current line is to be regarded as pa
2848    "Go to position before comment on the current line, or to end of line.    "Go to position before comment on the current line, or to end of line.
2849  Returns true if comment is found."  Returns true if comment is found."
2850    (let (state stop-in cpoint (lim (progn (end-of-line) (point))))    (let (state stop-in cpoint (lim (progn (end-of-line) (point))))
2851        (beginning-of-line)      (beginning-of-line)
2852        (if (or      (if (or
2853             (eq (get-text-property (point) 'syntax-type) 'pod)           (eq (get-text-property (point) 'syntax-type) 'pod)
2854             (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t))           (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t))
2855            (if (eq (preceding-char) ?\#) (progn (backward-char 1) t))          (if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
2856          ;; Else        ;; Else
2857          (while (not stop-in)        (while (not stop-in)
2858            (setq state (parse-partial-sexp (point) lim nil nil nil t))          (setq state (parse-partial-sexp (point) lim nil nil nil t))
2859                                          ; stop at comment                                          ; stop at comment
2860            ;; If fails (beginning-of-line inside sexp), then contains not-comment          ;; If fails (beginning-of-line inside sexp), then contains not-comment
2861            (if (nth 4 state)             ; After `#';          (if (nth 4 state)               ; After `#';
2862                                          ; (nth 2 state) can be                                          ; (nth 2 state) can be
2863                                          ; beginning of m,s,qq and so                                          ; beginning of m,s,qq and so
2864                                          ; on                                          ; on
2865                (if (nth 2 state)              (if (nth 2 state)
2866                    (progn                  (progn
2867                      (setq cpoint (point))                    (setq cpoint (point))
2868                      (goto-char (nth 2 state))                    (goto-char (nth 2 state))
2869                      (cond                    (cond
2870                       ((looking-at "\\(s\\|tr\\)\\>")                     ((looking-at "\\(s\\|tr\\)\\>")
2871                        (or (re-search-forward                      (or (re-search-forward
2872                             "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*"                           "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*"
2873                             lim 'move)                           lim 'move)
2874                            (setq stop-in t)))                          (setq stop-in t)))
2875                       ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>")                     ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>")
2876                        (or (re-search-forward                      (or (re-search-forward
2877                             "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#"                           "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#"
2878                             lim 'move)                           lim 'move)
2879                            (setq stop-in t)))                          (setq stop-in t)))
2880                       (t                 ; It was fair comment                     (t                   ; It was fair comment
2881                        (setq stop-in t)  ; Finish                      (setq stop-in t)    ; Finish
2882                        (goto-char (1- cpoint)))))                      (goto-char (1- cpoint)))))
2883                  (setq stop-in t)        ; Finish                (setq stop-in t)          ; Finish
2884                  (forward-char -1))                (forward-char -1))
2885              (setq stop-in t))           ; Finish            (setq stop-in t)))            ; Finish
2886            )        (nth 4 state))))
         (nth 4 state))))  
2887    
2888  (defsubst cperl-1- (p)  (defsubst cperl-1- (p)
2889    (max (point-min) (1- p)))    (max (point-min) (1- p)))
# Line 3031  Returns true if comment is found." Line 3030  Returns true if comment is found."
3030      ;; go-forward: has 2 args, and the second part is empty      ;; go-forward: has 2 args, and the second part is empty
3031      (list i i2 ender starter go-forward)))      (list i i2 ender starter go-forward)))
3032    
3033    (defvar font-lock-string-face)
3034    ;;(defvar font-lock-reference-face)
3035    (defvar font-lock-constant-face)
3036  (defsubst cperl-postpone-fontification (b e type val &optional now)  (defsubst cperl-postpone-fontification (b e type val &optional now)
3037    ;; Do after syntactic fontification?    ;; Do after syntactic fontification?
3038    (if cperl-syntaxify-by-font-lock    (if cperl-syntaxify-by-font-lock
3039        (or now (put-text-property b e 'cperl-postpone (cons type val)))        (or now (put-text-property b e 'cperl-postpone (cons type val)))
3040        (put-text-property b e type val)))      (put-text-property b e type val)))
3041    
3042  ;;; Here is how the global structures (those which cannot be  ;;; Here is how the global structures (those which cannot be
3043  ;;; recognized locally) are marked:  ;;; recognized locally) are marked:
# Line 3095  the sections using `cperl-pod-head-face' Line 3097  the sections using `cperl-pod-head-face'
3097                  cperl-syntax-state nil                  cperl-syntax-state nil
3098                  cperl-syntax-done-to min))                  cperl-syntax-done-to min))
3099    (or max (setq max (point-max)))    (or max (setq max (point-max)))
3100    (let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb    (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
3101                is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2           face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
3102                (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend           is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2
3103                (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)           (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
3104                (modified (buffer-modified-p))           (modified (buffer-modified-p))
3105                (after-change-functions nil)           (after-change-functions nil)
3106                (use-syntax-state (and cperl-syntax-state           (use-syntax-state (and cperl-syntax-state
3107                                       (>= min (car cperl-syntax-state))))                                  (>= min (car cperl-syntax-state))))
3108                (state-point (if use-syntax-state           (state-point (if use-syntax-state
3109                                 (car cperl-syntax-state)                            (car cperl-syntax-state)
3110                               (point-min)))                          (point-min)))
3111                (state (if use-syntax-state           (state (if use-syntax-state
3112                           (cdr cperl-syntax-state)))                      (cdr cperl-syntax-state)))
3113                ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call!           ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call!
3114                (st-l (list nil)) (err-l (list nil))           (st-l (list nil)) (err-l (list nil))
3115                ;; Somehow font-lock may be not loaded yet...           ;; Somehow font-lock may be not loaded yet...
3116                (font-lock-string-face (if (boundp 'font-lock-string-face)           (font-lock-string-face (if (boundp 'font-lock-string-face)
3117                                           font-lock-string-face                                      font-lock-string-face
3118                                         'font-lock-string-face))                                    'font-lock-string-face))
3119                (font-lock-constant-face (if (boundp 'font-lock-constant-face)           (font-lock-constant-face (if (boundp 'font-lock-constant-face)
3120                                           font-lock-constant-face                                        font-lock-constant-face
3121                                         'font-lock-constant-face))                                      'font-lock-constant-face))
3122                (font-lock-function-name-face           (font-lock-function-name-face
3123                 (if (boundp 'font-lock-function-name-face)            (if (boundp 'font-lock-function-name-face)
3124                     font-lock-function-name-face                font-lock-function-name-face
3125                   'font-lock-function-name-face))              'font-lock-function-name-face))
3126                (font-lock-comment-face           (font-lock-comment-face
3127                 (if (boundp 'font-lock-comment-face)            (if (boundp 'font-lock-comment-face)
3128                     font-lock-comment-face                font-lock-comment-face
3129                   'font-lock-comment-face))              'font-lock-comment-face))
3130                (cperl-nonoverridable-face           (cperl-nonoverridable-face
3131                 (if (boundp 'cperl-nonoverridable-face)            (if (boundp 'cperl-nonoverridable-face)
3132                     cperl-nonoverridable-face                cperl-nonoverridable-face
3133                   'cperl-nonoverridable-face))              'cperl-nonoverridable-face))
3134                (stop-point (if ignore-max           (stop-point (if ignore-max
3135                                (point-max)                           (point-max)
3136                              max))                         max))
3137                (search           (search
3138              (concat
3139               "\\(\\`\n?\\|^\n\\)="
3140               "\\|"
3141               ;; One extra () before this:
3142               "<<"
3143               "\\("                        ; 1 + 1
3144               ;; First variant "BLAH" or just ``.
3145               "[ \t]*"                     ; Yes, whitespace is allowed!
3146               "\\([\"'`]\\)"               ; 2 + 1 = 3
3147               "\\([^\"'`\n]*\\)"           ; 3 + 1
3148               "\\3"
3149               "\\|"
3150               ;; Second variant: Identifier or \ID or empty
3151               "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
3152               ;; Do not have <<= or << 30 or <<30 or << $blah.
3153               ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
3154               "\\(\\)"             ; To preserve count of pars :-( 6 + 1
3155               "\\)"
3156               "\\|"
3157               ;; 1+6 extra () before this:
3158               "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
3159               (if cperl-use-syntax-table-text-property
3160                 (concat                 (concat
                 "\\(\\`\n?\\|^\n\\)="  
3161                  "\\|"                  "\\|"
3162                  ;; One extra () before this:                  ;; 1+6+2=9 extra () before this:
3163                  "<<"                  "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
3164                    "\\("                 ; 1 + 1                  "\\|"
3165                    ;; First variant "BLAH" or just ``.                  ;; 1+6+2+1=10 extra () before this:
3166                       "[ \t]*"           ; Yes, whitespace is allowed!                  "\\([?/<]\\)"   ; /blah/ or ?blah? or <file*glob>
3167                       "\\([\"'`]\\)"     ; 2 + 1 = 3                  "\\|"
3168                       "\\([^\"'`\n]*\\)" ; 3 + 1                  ;; 1+6+2+1+1=11 extra () before this:
3169                       "\\3"                  "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"
3170                    "\\|"                  "\\|"
3171                    ;; Second variant: Identifier or \ID or empty                  ;; 1+6+2+1+1+2=13 extra () before this:
3172                      "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1                  "\\$\\(['{]\\)"
3173                      ;; Do not have <<= or << 30 or <<30 or << $blah.                  "\\|"
3174                      ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1                  ;; 1+6+2+1+1+2+1=14 extra () before this:
3175                      "\\(\\)"            ; To preserve count of pars :-( 6 + 1                  "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"
3176                    "\\)"                  ;; 1+6+2+1+1+2+1+1=15 extra () before this:
3177                    "\\|"
3178                    "__\\(END\\|DATA\\)__"
3179                    ;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
3180                  "\\|"                  "\\|"
3181                  ;; 1+6 extra () before this:                  "\\\\\\(['`\"]\\)")
3182                  "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"               ""))))
                 (if cperl-use-syntax-table-text-property  
                     (concat  
                      "\\|"  
                      ;; 1+6+2=9 extra () before this:  
                      "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"  
                      "\\|"  
                      ;; 1+6+2+1=10 extra () before this:  
                      "\\([?/<]\\)"      ; /blah/ or ?blah? or <file*glob>  
                      "\\|"  
                      ;; 1+6+2+1+1=11 extra () before this:  
                      "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"  
                      "\\|"  
                      ;; 1+6+2+1+1+2=13 extra () before this:  
                      "\\$\\(['{]\\)"  
                      "\\|"  
                      ;; 1+6+2+1+1+2+1=14 extra () before this:  
                      "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"  
                      ;; 1+6+2+1+1+2+1+1=15 extra () before this:  
                      "\\|"  
                      "__\\(END\\|DATA\\)__"  
                      ;; 1+6+2+1+1+2+1+1+1=16 extra () before this:  
                      "\\|"  
                      "\\\\\\(['`\"]\\)"  
                      )  
                   ""))))  
3183      (unwind-protect      (unwind-protect
3184          (progn          (progn
3185            (save-excursion            (save-excursion
3186              (or non-inter              (or non-inter
3187                  (message "Scanning for \"hard\" Perl constructions..."))                  (message "Scanning for \"hard\" Perl constructions..."))
3188              (and cperl-pod-here-fontify              (and cperl-pod-here-fontify
3189                  ;; We had evals here, do not know why...                   ;; We had evals here, do not know why...
3190                  (setq face cperl-pod-face                   (setq face cperl-pod-face
3191                        head-face cperl-pod-head-face                         head-face cperl-pod-head-face
3192                        here-face cperl-here-face))                         here-face cperl-here-face))
3193              (remove-text-properties min max              (remove-text-properties min max
3194                                      '(syntax-type t in-pod t syntax-table t                                      '(syntax-type t in-pod t syntax-table t
3195                                                    cperl-postpone t                                                    cperl-postpone t
# Line 3279  the sections using `cperl-pod-head-face' Line 3280  the sections using `cperl-pod-head-face'
3280                    (cperl-commentify bb e nil)                    (cperl-commentify bb e nil)
3281                    (goto-char e)                    (goto-char e)
3282                    (or (eq e (point-max))                    (or (eq e (point-max))
3283                        (forward-char -1)))) ; Prepare for immediate pod start.                        (forward-char -1)))) ; Prepare for immediate POD start.
3284                 ;; Here document                 ;; Here document
3285                 ;; We do only one here-per-line                 ;; We do only one here-per-line
3286                 ;; ;; One extra () before this:                 ;; ;; One extra () before this:
# Line 3333  the sections using `cperl-pod-head-face' Line 3334  the sections using `cperl-pod-head-face'
3334                               (progn                               (progn
3335                                 ;; Highlight the ending delimiter                                 ;; Highlight the ending delimiter
3336                                 (cperl-postpone-fontification (match-beginning 0) (match-end 0)                                 (cperl-postpone-fontification (match-beginning 0) (match-end 0)
3337                                                    'face font-lock-constant-face)                                                               'face font-lock-constant-face)
3338                                 (cperl-put-do-not-fontify b (match-end 0) t)                                 (cperl-put-do-not-fontify b (match-end 0) t)
3339                                 ;; Highlight the HERE-DOC                                 ;; Highlight the HERE-DOC
3340                                 (cperl-postpone-fontification b (match-beginning 0)                                 (cperl-postpone-fontification b (match-beginning 0)
3341                                                    'face here-face)))                                                               'face here-face)))
3342                           (setq e1 (cperl-1+ (match-end 0)))                           (setq e1 (cperl-1+ (match-end 0)))
3343                           (put-text-property b (match-beginning 0)                           (put-text-property b (match-beginning 0)
3344                                              'syntax-type 'here-doc)                                              'syntax-type 'here-doc)
# Line 3379  the sections using `cperl-pod-head-face' Line 3380  the sections using `cperl-pod-head-face'
3380                          (end-of-line)                          (end-of-line)
3381                          ;; Highlight the format line                          ;; Highlight the format line
3382                          (cperl-postpone-fontification b1 (point)                          (cperl-postpone-fontification b1 (point)
3383                                             'face font-lock-string-face)                                                        'face font-lock-string-face)
3384                          (cperl-commentify b1 (point) nil)                          (cperl-commentify b1 (point) nil)
3385                          (cperl-put-do-not-fontify b1 (point) t))))                          (cperl-put-do-not-fontify b1 (point) t))))
3386                    ;; We do not search to max, since we may be called from                    ;; We do not search to max, since we may be called from
3387                    ;; some hook of fontification, and max is random                    ;; some hook of fontification, and max is random
3388                    (re-search-forward "^[.;]$" stop-point 'toend))                    (re-search-forward "^[.;]$" stop-point 'toend))
3389                  (beginning-of-line)                  (beginning-of-line)
3390                  (if (looking-at "^\\.$")        ; ";" is not supported yet                  (if (looking-at "^\\.$") ; ";" is not supported yet
3391                      (progn                      (progn
3392                        ;; Highlight the ending delimiter                        ;; Highlight the ending delimiter
3393                        (cperl-postpone-fontification (point) (+ (point) 2)                        (cperl-postpone-fontification (point) (+ (point) 2)
3394                                           'face font-lock-string-face)                                                      'face font-lock-string-face)
3395                        (cperl-commentify (point) (+ (point) 2) nil)                        (cperl-commentify (point) (+ (point) 2) nil)
3396                        (cperl-put-do-not-fontify (point) (+ (point) 2) t))                        (cperl-put-do-not-fontify (point) (+ (point) 2) t))
3397                    (message "End of format `%s' not found." name)                    (message "End of format `%s' not found." name)
# Line 3418  the sections using `cperl-pod-head-face' Line 3419  the sections using `cperl-pod-head-face'
3419                                (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y                                (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
3420                                (and (eq bb ?-) (eq c ?s)) ; -s file test                                (and (eq bb ?-) (eq c ?s)) ; -s file test
3421                                (and (eq bb ?\&)                                (and (eq bb ?\&)
3422                                     (not (eq (char-after  ; &&m/blah/                                     (not (eq (char-after ; &&m/blah/
3423                                               (- (match-beginning b1) 2))                                               (- (match-beginning b1) 2))
3424                                              ?\&))))                                              ?\&))))
3425                             ;; <file> or <$file>                             ;; <file> or <$file>
# Line 3599  the sections using `cperl-pod-head-face' Line 3600  the sections using `cperl-pod-head-face'
3600                                      (if is-x-REx                                      (if is-x-REx
3601                                          (if (eq (char-after b) ?\#)                                          (if (eq (char-after b) ?\#)
3602                                              "\\((\\?\\\\#\\)\\|\\(\\\\#\\)"                                              "\\((\\?\\\\#\\)\\|\\(\\\\#\\)"
3603                                              "\\((\\?#\\)\\|\\(#\\)")                                            "\\((\\?#\\)\\|\\(#\\)")
3604                                          (if (eq (char-after b) ?\#)                                        (if (eq (char-after b) ?\#)
3605                                              "\\((\\?\\\\#\\)"                                            "\\((\\?\\\\#\\)"
3606                                            "\\((\\?#\\)"))                                          "\\((\\?#\\)"))
3607                                      (1- e) 'to-end))                                      (1- e) 'to-end))
3608                              (goto-char (match-beginning 0))                              (goto-char (match-beginning 0))
3609                              (setq REx-comment-start (point)                              (setq REx-comment-start (point)
# Line 3744  the sections using `cperl-pod-head-face' Line 3745  the sections using `cperl-pod-head-face'
3745        (if (memq (setq pr (get-text-property (point) 'syntax-type))        (if (memq (setq pr (get-text-property (point) 'syntax-type))
3746                  '(pod here-doc here-doc-delim))                  '(pod here-doc here-doc-delim))
3747            (cperl-unwind-to-safe nil)            (cperl-unwind-to-safe nil)
3748        (if (or (looking-at "^[ \t]*\\(#\\|$\\)")        (or (looking-at "^[ \t]*\\(#\\|$\\)")
3749                (progn (cperl-to-comment-or-eol) (bolp)))            (progn (cperl-to-comment-or-eol) (bolp))
3750            nil   ; Only comment, skip            (progn
3751          ;; Else              (skip-chars-backward " \t")
3752          (skip-chars-backward " \t")              (if (< p (point)) (goto-char p))
3753          (if (< p (point)) (goto-char p))              (setq stop t)))))))
           (setq stop t))))))  
3754    
3755  (defun cperl-after-block-p (lim)  (defun cperl-after-block-p (lim)
3756    ;; We suppose that the preceding char is }.    ;; We suppose that the preceding char is }.
# Line 3780  the sections using `cperl-pod-head-face' Line 3780  the sections using `cperl-pod-head-face'
3780  TEST is the expression to evaluate at the found position.  If absent,  TEST is the expression to evaluate at the found position.  If absent,
3781  CHARS is a string that contains good characters to have before us (however,  CHARS is a string that contains good characters to have before us (however,
3782  `}' is treated \"smartly\" if it is not in the list)."  `}' is treated \"smartly\" if it is not in the list)."
3783    (let (stop p    (let ((lim (or lim (point-min)))
3784               (lim (or lim (point-min))))          stop p)
3785      (save-excursion      (save-excursion
3786        (while (and (not stop) (> (point) lim))        (while (and (not stop) (> (point) lim))
3787          (skip-chars-backward " \t\n\f" lim)          (skip-chars-backward " \t\n\f" lim)
# Line 3874  Returns some position at the last line." Line 3874  Returns some position at the last line."
3874    (interactive)    (interactive)
3875    (or end    (or end
3876        (setq end (point-max)))        (setq end (point-max)))
3877    (let (p pp ml have-brace ret    (let ((ee (save-excursion (end-of-line) (point)))
3878            (ee (save-excursion (end-of-line) (point)))          (cperl-indent-region-fix-constructs
3879            (cperl-indent-region-fix-constructs           (or cperl-indent-region-fix-constructs 1))
3880             (or cperl-indent-region-fix-constructs 1)))          p pp ml have-brace ret)
3881      (save-excursion      (save-excursion
3882        (beginning-of-line)        (beginning-of-line)
3883        (setq ret (point))        (setq ret (point))
# Line 3887  Returns some position at the last line." Line 3887  Returns some position at the last line."
3887             (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)")             (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)")
3888                 (setq have-brace (save-excursion (search-forward "}" ee t)))))                 (setq have-brace (save-excursion (search-forward "}" ee t)))))
3889            nil                           ; Do not need to do anything            nil                           ; Do not need to do anything
3890        ;; Looking at:          ;; Looking at:
3891        ;; }          ;; }
3892        ;; else          ;; else
3893        (if (and cperl-merge-trailing-else          (if (and cperl-merge-trailing-else
3894                 (looking-at                   (looking-at
3895                  "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>"))                    "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>"))
3896            (progn              (progn
3897              (search-forward "}")                (search-forward "}")
3898              (setq p (point))                (setq p (point))
3899              (skip-chars-forward " \t\n")                (skip-chars-forward " \t\n")
3900              (delete-region p (point))                (delete-region p (point))
3901              (insert (make-string cperl-indent-region-fix-constructs ?\ ))                (insert (make-string cperl-indent-region-fix-constructs ?\ ))
3902              (beginning-of-line)))                (beginning-of-line)))
3903        ;; Looking at:          ;; Looking at:
3904        ;; }     else          ;; }     else
3905        (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")          (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")
3906            (progn              (progn
3907              (search-forward "}")                (search-forward "}")
3908              (delete-horizontal-space)                (delete-horizontal-space)
3909              (insert (make-string cperl-indent-region-fix-constructs ?\ ))                (insert (make-string cperl-indent-region-fix-constructs ?\ ))
3910              (beginning-of-line)))                (beginning-of-line)))
3911        ;; Looking at:          ;; Looking at:
3912        ;; else   {          ;; else   {
3913        (if (looking-at          (if (looking-at
3914             "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")               "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
3915            (progn              (progn
3916              (forward-word 1)                (forward-word 1)
3917              (delete-horizontal-space)                (delete-horizontal-space)
3918              (insert (make-string cperl-indent-region-fix-constructs ?\ ))                (insert (make-string cperl-indent-region-fix-constructs ?\ ))
3919              (beginning-of-line)))                (beginning-of-line)))
3920        ;; Looking at:          ;; Looking at:
3921        ;; foreach my    $var          ;; foreach my    $var
3922        (if (looking-at          (if (looking-at
3923             "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]")               "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]")
3924            (progn              (progn
3925              (forward-word 2)                (forward-word 2)
3926              (delete-horizontal-space)                (delete-horizontal-space)
3927              (insert (make-string cperl-indent-region-fix-constructs ?\ ))                (insert (make-string cperl-indent-region-fix-constructs ?\ ))
3928              (beginning-of-line)))                (beginning-of-line)))
3929        ;; Looking at:          ;; Looking at:
3930        ;; foreach my $var     (          ;; foreach my $var     (
3931        (if (looking-at          (if (looking-at
3932               "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")               "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
3933            (progn              (progn
3934              (forward-word 3)                (forward-word 3)
3935              (delete-horizontal-space)                (delete-horizontal-space)
3936              (insert                (insert
3937               (make-string cperl-indent-region-fix-constructs ?\ ))                 (make-string cperl-indent-region-fix-constructs ?\ ))
3938              (beginning-of-line)))                (beginning-of-line)))
3939        ;; Looking at:          ;; Looking at:
3940        ;; } foreach my $var ()    {          ;; } foreach my $var ()    {
3941        (if (looking-at          (if (looking-at
3942               "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")               "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")
3943            (progn              (progn
3944              (setq ml (match-beginning 8))                (setq ml (match-beginning 8))
3945              (re-search-forward "[({]")                (re-search-forward "[({]")
3946              (forward-char -1)                (forward-char -1)
3947              (setq p (point))                (setq p (point))
3948              (if (eq (following-char) ?\( )                (if (eq (following-char) ?\( )
3949                  (progn                    (progn
3950                    (forward-sexp 1)                      (forward-sexp 1)
3951                    (setq pp (point)))                      (setq pp (point)))
3952                ;; after `else' or nothing                  ;; after `else' or nothing
3953                (if ml    ; after `else'                  (if ml                  ; after `else'
3954                    (skip-chars-backward " \t\n")                      (skip-chars-backward " \t\n")
3955                  (beginning-of-line))                    (beginning-of-line))
3956                (setq pp nil))                  (setq pp nil))
3957              ;; Now after the sexp before the brace                ;; Now after the sexp before the brace
3958              ;; Multiline expr should be special                ;; Multiline expr should be special
3959              (setq ml (and pp (save-excursion (goto-char p)                (setq ml (and pp (save-excursion (goto-char p)
3960                                               (search-forward "\n" pp t))))                                                 (search-forward "\n" pp t))))
3961              (if (and (or (not pp) (< pp end))                (if (and (or (not pp) (< pp end))
3962                       (looking-at "[ \t\n]*{"))                         (looking-at "[ \t\n]*{"))
3963                  (progn                    (progn
3964                    (cond                      (cond
3965                     ((bolp)              ; Were before `{', no if/else/etc                       ((bolp)            ; Were before `{', no if/else/etc
3966                      nil)                        nil)
3967                     ((looking-at "\\(\t*\\| [ \t]+\\){")                       ((looking-at "\\(\t*\\| [ \t]+\\){")
3968                      (delete-horizontal-space)                        (delete-horizontal-space)
3969                      (if (if ml                        (if (if ml
3970                              cperl-extra-newline-before-brace-multiline                                cperl-extra-newline-before-brace-multiline
3971                            cperl-extra-newline-before-brace)                              cperl-extra-newline-before-brace)
3972                          (progn                            (progn
3973                            (delete-horizontal-space)                              (delete-horizontal-space)
3974                            (insert "\n")                              (insert "\n")
3975                            (setq ret (point))                              (setq ret (point))
3976                            (if (cperl-indent-line parse-data)                              (if (cperl-indent-line parse-data)
3977                                (progn                                  (progn
3978                                  (cperl-fix-line-spacing end parse-data)                                    (cperl-fix-line-spacing end parse-data)
3979                                  (setq ret (point)))))                                    (setq ret (point)))))
3980                            (insert
3981                             (make-string cperl-indent-region-fix-constructs ?\ ))))
3982                         ((and (looking-at "[ \t]*\n")
3983                               (not (if ml
3984                                        cperl-extra-newline-before-brace-multiline
3985                                      cperl-extra-newline-before-brace)))
3986                          (setq pp (point))
3987                          (skip-chars-forward " \t\n")
3988                          (delete-region pp (point))
3989                        (insert                        (insert
3990                         (make-string cperl-indent-region-fix-constructs ?\ ))))                         (make-string cperl-indent-region-fix-constructs ?\ ))))
3991                     ((and (looking-at "[ \t]*\n")                      ;; Now we are before `{'
3992                           (not (if ml                      (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]")
3993                                    cperl-extra-newline-before-brace-multiline                          (progn
3994                                  cperl-extra-newline-before-brace)))                            (skip-chars-forward " \t\n")
3995                      (setq pp (point))                            (setq pp (point))
3996                      (skip-chars-forward " \t\n")                            (forward-sexp 1)
3997                      (delete-region pp (point))                            (setq p (point))
3998                      (insert                            (goto-char pp)
3999                       (make-string cperl-indent-region-fix-constructs ?\ ))))                            (setq ml (search-forward "\n" p t))
4000                    ;; Now we are before `{'                            (if (or cperl-break-one-line-blocks-when-indent ml)
4001                    (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]")                                ;; not good: multi-line BLOCK
4002                        (progn                                (progn
4003                          (skip-chars-forward " \t\n")                                  (goto-char (1+ pp))
4004                          (setq pp (point))                                  (delete-horizontal-space)
4005                          (forward-sexp 1)                                  (insert "\n")
4006                          (setq p (point))                                  (setq ret (point))
4007                          (goto-char pp)                                  (if (cperl-indent-line parse-data)
4008                          (setq ml (search-forward "\n" p t))                                      (setq ret (cperl-fix-line-spacing end parse-data)))))))))))
4009                          (if (or cperl-break-one-line-blocks-when-indent ml)          (beginning-of-line)
4010                              ;; not good: multi-line BLOCK          (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.
4011                              (progn          ;; Now check whether there is a hanging `}'
4012                                (goto-char (1+ pp))          ;; Looking at:
4013                                (delete-horizontal-space)          ;; } blah
4014                                (insert "\n")          (if (and
4015                                (setq ret (point))               cperl-fix-hanging-brace-when-indent
4016                                (if (cperl-indent-line parse-data)               have-brace
4017                                    (setq ret (cperl-fix-line-spacing end parse-data)))))))))))               (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)"))
4018        (beginning-of-line)               (condition-case nil
4019        (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.                   (progn
4020        ;; Now check whether there is a hanging `}'                     (up-list 1)
4021        ;; Looking at:                     (if (and (<= (point) pp)
4022        ;; } blah                              (eq (preceding-char) ?\} )
4023        (if (and                              (cperl-after-block-and-statement-beg (point-min)))
4024             cperl-fix-hanging-brace-when-indent                         t
4025             have-brace                       (goto-char p)
4026             (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)"))                       nil))
4027             (condition-case nil                 (error nil)))
4028                 (progn              (progn
4029                   (up-list 1)                (forward-char -1)
4030                   (if (and (<= (point) pp)                (skip-chars-backward " \t")
4031                            (eq (preceding-char) ?\} )                (if (bolp)
4032                            (cperl-after-block-and-statement-beg (point-min)))                    ;; `}' was the first thing on the line, insert NL *after* it.
4033                       t                    (progn
4034                     (goto-char p)                      (cperl-indent-line parse-data)
4035                     nil))                      (search-forward "}")
4036               (error nil)))                      (delete-horizontal-space)
4037            (progn                      (insert "\n"))
4038              (forward-char -1)                  (delete-horizontal-space)
4039              (skip-chars-backward " \t")                  (or (eq (preceding-char) ?\;)
4040              (if (bolp)                      (bolp)
4041                  ;; `}' was the first thing on the line, insert NL *after* it.                      (and (eq (preceding-char) ?\} )
4042                  (progn                           (cperl-after-block-p (point-min)))
4043                    (cperl-indent-line parse-data)                      (insert ";"))
4044                    (search-forward "}")                  (insert "\n")
4045                    (delete-horizontal-space)                  (setq ret (point)))
4046                    (insert "\n"))                (if (cperl-indent-line parse-data)
4047                (delete-horizontal-space)                    (setq ret (cperl-fix-line-spacing end parse-data)))
4048                (or (eq (preceding-char) ?\;)                (beginning-of-line)))))
                   (bolp)  
                   (and (eq (preceding-char) ?\} )  
                        (cperl-after-block-p (point-min)))  
                   (insert ";"))  
               (insert "\n")  
               (setq ret (point)))  
             (if (cperl-indent-line parse-data)  
                 (setq ret (cperl-fix-line-spacing end parse-data)))  
             (beginning-of-line)))))  
4049      ret))      ret))
4050    
4051  (defvar cperl-update-start)             ; Do not need to make them local  (defvar cperl-update-start)             ; Do not need to make them local
# Line 4067  conditional/loop constructs." Line 4067  conditional/loop constructs."
4067    (cperl-update-syntaxification end end)    (cperl-update-syntaxification end end)
4068    (save-excursion    (save-excursion
4069      (let (cperl-update-start cperl-update-end (h-a-c after-change-functions))      (let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
4070        (let (st comm old-comm-indent new-comm-indent p pp i empty        (let ((indent-info (if cperl-emacs-can-parse
4071                 (indent-info (if cperl-emacs-can-parse                               (list nil nil nil) ; Cannot use '(), since will modify
4072                                  (list nil nil nil) ; Cannot use '(), since will modify                             nil))
4073                                nil))              (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")
4074                 after-change-functions   ; Speed it up!              after-change-functions      ; Speed it up!
4075               (pm 0) (imenu-scanning-message "Indenting... (%3d%%)"))              st comm old-comm-indent new-comm-indent p pp i empty)
4076          (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook))          (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook))
4077        (goto-char start)          (goto-char start)
4078        (setq old-comm-indent (and (cperl-to-comment-or-eol)          (setq old-comm-indent (and (cperl-to-comment-or-eol)
4079                                   (current-column))                                     (current-column))
4080              new-comm-indent old-comm-indent)                new-comm-indent old-comm-indent)
4081        (goto-char start)          (goto-char start)
4082        (setq end (set-marker (make-marker) end)) ; indentation changes pos          (setq end (set-marker (make-marker) end)) ; indentation changes pos
4083        (or (bolp) (beginning-of-line 2))          (or (bolp) (beginning-of-line 2))
4084        (or (fboundp 'imenu-progress-message)          (or (fboundp 'imenu-progress-message)
4085            (message "Indenting... For feedback load `imenu'..."))              (message "Indenting... For feedback load `imenu'..."))
4086        (while (and (<= (point) end) (not (eobp))) ; bol to check start          (while (and (<= (point) end) (not (eobp))) ; bol to check start
4087          (and (fboundp 'imenu-progress-message)            (and (fboundp 'imenu-progress-message)
4088               (imenu-progress-message                 (imenu-progress-message
4089                pm (/ (* 100 (- (point) start)) (- end start -1))))                  pm (/ (* 100 (- (point) start)) (- end start -1))))
4090            (setq st (point))            (setq st (point))
4091            (if (or            (if (or
4092                 (setq empty (looking-at "[ \t]*\n"))                 (setq empty (looking-at "[ \t]*\n"))
4093                 (and (setq comm (looking-at "[ \t]*#"))                 (and (setq comm (looking-at "[ \t]*#"))
4094                   (or (eq (current-indentation) (or old-comm-indent                      (or (eq (current-indentation) (or old-comm-indent
4095                                                     comment-column))                                                        comment-column))
4096                          (setq old-comm-indent nil))))                          (setq old-comm-indent nil))))
4097              (if (and old-comm-indent              (if (and old-comm-indent
4098                         (not empty)                         (not empty)
# Line 4100  conditional/loop constructs." Line 4100  conditional/loop constructs."
4100                         (not (eq (get-text-property (point) 'syntax-type) 'pod))                         (not (eq (get-text-property (point) 'syntax-type) 'pod))
4101                         (not (eq (get-text-property (point) 'syntax-table)                         (not (eq (get-text-property (point) 'syntax-table)
4102                                  cperl-st-cfence)))                                  cperl-st-cfence)))
4103                  (let ((comment-column new-comm-indent))                    (let ((comment-column new-comm-indent))
4104                    (indent-for-comment)))                      (indent-for-comment)))
4105            (progn              (progn
4106                (setq i (cperl-indent-line indent-info))                (setq i (cperl-indent-line indent-info))
4107              (or comm              (or comm
4108                  (not i)                  (not i)
4109                  (progn                  (progn
4110                    (if cperl-indent-region-fix-constructs                    (if cperl-indent-region-fix-constructs
4111                          (goto-char (cperl-fix-line-spacing end indent-info)))                          (goto-char (cperl-fix-line-spacing end indent-info)))
4112                    (if (setq old-comm-indent                      (if (setq old-comm-indent
4113                              (and (cperl-to-comment-or-eol)                                (and (cperl-to-comment-or-eol)
4114                                   (not (memq (get-text-property (point)                                     (not (memq (get-text-property (point)
4115                                                                 'syntax-type)                                                                   'syntax-type)
4116                                              '(pod here-doc)))                                                '(pod here-doc)))
4117                                     (not (eq (get-text-property (point)                                     (not (eq (get-text-property (point)
4118                                                                 'syntax-table)                                                                 'syntax-table)
4119                                              cperl-st-cfence))                                              cperl-st-cfence))
# Line 4127  conditional/loop constructs." Line 4127  conditional/loop constructs."
4127               (imenu-progress-message pm 100)               (imenu-progress-message pm 100)
4128            (message nil)))            (message nil)))
4129        ;; Now run the update hooks        ;; Now run the update hooks
4130        (if after-change-functions        (and after-change-functions
4131            (save-excursion             cperl-update-end
4132              (if cperl-update-end             (save-excursion
4133                  (progn               (goto-char cperl-update-end)
4134                    (goto-char cperl-update-end)               (insert " ")
4135                    (insert " ")               (delete-char -1)
4136                    (delete-char -1)               (goto-char cperl-update-start)
4137                    (goto-char cperl-update-start)               (insert " ")
4138                    (insert " ")               (delete-char -1))))))
                   (delete-char -1))))))))  
4139    
4140  ;; Stolen from lisp-mode with a lot of improvements  ;; Stolen from lisp-mode with a lot of improvements
4141    
# Line 4146  If any of the current line is a comment, Line 4145  If any of the current line is a comment,
4145  block of it that point is in, preserving the comment's initial  block of it that point is in, preserving the comment's initial
4146  indentation and initial hashes.  Behaves usually outside of comment."  indentation and initial hashes.  Behaves usually outside of comment."
4147    (interactive "P")    (interactive "P")
4148    (let (    (let (;; Non-nil if the current line contains a comment.
         ;; Non-nil if the current line contains a comment.  
4149          has-comment          has-comment
4150    
4151          ;; If has-comment, the appropriate fill-prefix for the comment.          ;; If has-comment, the appropriate fill-prefix for the comment.
# Line 4183  indentation and initial hashes.  Behaves Line 4181  indentation and initial hashes.  Behaves
4181          (delete-char len)          (delete-char len)
4182          (insert (make-string dc ?-)))))          (insert (make-string dc ?-)))))
4183      (if (not has-comment)      (if (not has-comment)
4184          (fill-paragraph justify)        ; Do the usual thing outside of comment          (fill-paragraph justify)       ; Do the usual thing outside of comment
4185        ;; Narrow to include only the comment, and then fill the region.        ;; Narrow to include only the comment, and then fill the region.
4186        (save-restriction        (save-restriction
4187          (narrow-to-region          (narrow-to-region
# Line 4217  indentation and initial hashes.  Behaves Line 4215  indentation and initial hashes.  Behaves
4215            (progn            (progn
4216              (goto-char start)              (goto-char start)
4217              (if (> dc 0)              (if (> dc 0)
4218                (progn (delete-char dc) (insert spaces)))                  (progn (delete-char dc) (insert spaces)))
4219              (if (or (= (current-column) c) iteration) nil              (if (or (= (current-column) c) iteration) nil
4220                (setq comment-column c)                (setq comment-column c)
4221                (indent-for-comment)                (indent-for-comment)
# Line 4230  indentation and initial hashes.  Behaves Line 4228  indentation and initial hashes.  Behaves
4228             (end-of-line)             (end-of-line)
4229             (current-column))             (current-column))
4230           fill-column)           fill-column)
4231    (let ((c (save-excursion (beginning-of-line)        (let ((c (save-excursion (beginning-of-line)
4232                             (cperl-to-comment-or-eol) (point)))                                 (cperl-to-comment-or-eol) (point)))
4233          (s (memq (following-char) '(?\  ?\t))) marker)              (s (memq (following-char) '(?\ ?\t))) marker)
4234      (if (>= c (point)) nil          (if (>= c (point)) nil
4235        (setq marker (point-marker))            (setq marker (point-marker))
4236        (cperl-fill-paragraph)            (cperl-fill-paragraph)
4237        (goto-char marker)            (goto-char marker)
4238        ;; Is not enough, sometimes marker is a start of line            ;; Is not enough, sometimes marker is a start of line
4239        (if (bolp) (progn (re-search-forward "#+[ \t]*")            (if (bolp) (progn (re-search-forward "#+[ \t]*")
4240                          (goto-char (match-end 0))))                              (goto-char (match-end 0))))
4241        ;; Following space could have gone:            ;; Following space could have gone:
4242        (if (or (not s) (memq (following-char) '(?\  ?\t))) nil            (if (or (not s) (memq (following-char) '(?\ ?\t))) nil
4243          (insert " ")              (insert " ")
4244          (backward-char 1))              (backward-char 1))
4245        ;; Previous space could have gone:            ;; Previous space could have gone:
4246        (or (memq (preceding-char) '(?\  ?\t)) (insert " "))))))            (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
4247    
4248  (defun cperl-imenu-addback (lst &optional isback name)  (defun cperl-imenu-addback (lst &optional isback name)
4249    ;; We suppose that the lst is a DAG, unless the first element only    ;; We suppose that the lst is a DAG, unless the first element only
# Line 4255  indentation and initial hashes.  Behaves Line 4253  indentation and initial hashes.  Behaves
4253          (t          (t
4254           (or name           (or name
4255               (setq name "+++BACK+++"))               (setq name "+++BACK+++"))
4256           (mapcar (function (lambda (elt)           (mapcar (lambda (elt)
4257                               (if (and (listp elt) (listp (cdr elt)))                     (if (and (listp elt) (listp (cdr elt)))
4258                                   (progn                         (progn
4259                                     ;; In the other order it goes up                           ;; In the other order it goes up
4260                                     ;; one level only ;-(                           ;; one level only ;-(
4261                                     (setcdr elt (cons (cons name lst)                           (setcdr elt (cons (cons name lst)
4262                                                       (cdr elt)))                                             (cdr elt)))
4263                                     (cperl-imenu-addback (cdr elt) t name)                           (cperl-imenu-addback (cdr elt) t name))))
                                    ))))  
4264                   (if isback (cdr lst) lst))                   (if isback (cdr lst) lst))
4265           lst)))           lst)))
4266    
# Line 4291  indentation and initial hashes.  Behaves Line 4288  indentation and initial hashes.  Behaves
4288             (match-beginning 2)          ; package or sub             (match-beginning 2)          ; package or sub
4289             (eq (char-after (match-beginning 2)) ?p) ; package             (eq (char-after (match-beginning 2)) ?p) ; package
4290             (not (save-match-data             (not (save-match-data
4291                    (looking-at "[ \t\n]*;"))))  ; Plain text word 'package'                    (looking-at "[ \t\n]*;")))) ; Plain text word 'package'
4292            nil)            nil)
4293           ((and           ((and
4294             (match-beginning 2)          ; package or sub             (match-beginning 2)          ; package or sub
# Line 4301  indentation and initial hashes.  Behaves Line 4298  indentation and initial hashes.  Behaves
4298             (null (get-text-property (match-beginning 1) 'in-pod)))             (null (get-text-property (match-beginning 1) 'in-pod)))
4299            (save-excursion            (save-excursion
4300              (goto-char (match-beginning 2))              (goto-char (match-beginning 2))
4301              (setq fchar (following-char))              (setq fchar (following-char)))
             )  
4302            ;; (if (looking-at "([^()]*)[ \t\n\f]*")            ;; (if (looking-at "([^()]*)[ \t\n\f]*")
4303            ;;    (goto-char (match-end 0)))      ; Messes what follows            ;;    (goto-char (match-end 0)))      ; Messes what follows
4304            (setq char (following-char)   ; ?\; for "sub foo () ;"            (setq char (following-char)   ; ?\; for "sub foo () ;"
# Line 4345  indentation and initial hashes.  Behaves Line 4341  indentation and initial hashes.  Behaves
4341                (push index index-alist))                (push index index-alist))
4342              (if meth (push index index-meth-alist))              (if meth (push index index-meth-alist))
4343              (push index index-unsorted-alist)))              (push index index-unsorted-alist)))
4344           ((match-beginning 5)           ; Pod section           ((match-beginning 5)           ; POD section
4345            ;; (beginning-of-line)            ;; (beginning-of-line)
4346            (setq index (imenu-example--name-and-position)            (setq index (imenu-example--name-and-position)
4347                  name (buffer-substring (match-beginning 6) (match-end 6)))                  name (buffer-substring (match-beginning 6) (match-end 6)))
# Line 4361  indentation and initial hashes.  Behaves Line 4357  indentation and initial hashes.  Behaves
4357      (setq index-alist      (setq index-alist
4358            (if (default-value 'imenu-sort-function)            (if (default-value 'imenu-sort-function)
4359                (sort index-alist (default-value 'imenu-sort-function))                (sort index-alist (default-value 'imenu-sort-function))
4360                (nreverse index-alist)))              (nreverse index-alist)))
4361      (and index-pod-alist      (and index-pod-alist
4362           (push (cons "+POD headers+..."           (push (cons "+POD headers+..."
4363                       (nreverse index-pod-alist))                       (nreverse index-pod-alist))
# Line 4437  indentation and initial hashes.  Behaves Line 4433  indentation and initial hashes.  Behaves
4433    
4434  (if (fboundp 'eval-after-load)  (if (fboundp 'eval-after-load)
4435      (eval-after-load      (eval-after-load
4436       "mode-compile"          "mode-compile"
4437       '(setq perl-compilation-error-regexp-alist        '(setq perl-compilation-error-regexp-alist
4438             cperl-compilation-error-regexp-alist)))               cperl-compilation-error-regexp-alist)))
4439    
4440    
4441  (defun cperl-windowed-init ()  (defun cperl-windowed-init ()
# Line 4455  indentation and initial hashes.  Behaves Line 4451  indentation and initial hashes.  Behaves
4451                         (or cperl-faces-init (cperl-init-faces)))))))                         (or cperl-faces-init (cperl-init-faces)))))))
4452      (if (fboundp 'eval-after-load)      (if (fboundp 'eval-after-load)
4453          (eval-after-load          (eval-after-load
4454           "ps-print"              "ps-print"
4455           '(or cperl-faces-init (cperl-init-faces))))))            '(or cperl-faces-init (cperl-init-faces))))))
4456    
4457  (defvar cperl-font-lock-keywords-1 nil  (defvar cperl-font-lock-keywords-1 nil
4458    "Additional expressions to highlight in Perl mode.  Minimal set.")    "Additional expressions to highlight in Perl mode.  Minimal set.")
# Line 4633  indentation and initial hashes.  Behaves Line 4629  indentation and initial hashes.  Behaves
4629              '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1              '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
4630                font-lock-string-face t)                font-lock-string-face t)
4631              '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1              '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
4632                font-lock-constant-face) ; labels                font-lock-constant-face)  ; labels
4633              '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets              '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
4634                2 font-lock-constant-face)                2 font-lock-constant-face)
4635              ;; Uncomment to get perl-mode-like vars              ;; Uncomment to get perl-mode-like vars
# Line 4661  indentation and initial hashes.  Behaves Line 4657  indentation and initial hashes.  Behaves
4657            (setq            (setq
4658             t-font-lock-keywords-1             t-font-lock-keywords-1
4659             (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock             (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
4660                  (not cperl-xemacs-p) ; not yet as of XEmacs 19.12                  (not cperl-xemacs-p)    ; not yet as of XEmacs 19.12
4661                  '(                  '(
4662                    ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1                    ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
4663                     (if (eq (char-after (match-beginning 2)) ?%)                     (if (eq (char-after (match-beginning 2)) ?%)
# Line 4701  indentation and initial hashes.  Behaves Line 4697  indentation and initial hashes.  Behaves
4697          (if (fboundp 'ps-print-buffer) (cperl-ps-print-init))          (if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
4698          (if (or (featurep 'choose-color) (featurep 'font-lock-extra))          (if (or (featurep 'choose-color) (featurep 'font-lock-extra))
4699              (eval                       ; Avoid a warning              (eval                       ; Avoid a warning
4700              '(font-lock-require-faces               '(font-lock-require-faces
4701               (list                 (list
4702                ;; Color-light    Color-dark      Gray-light      Gray-dark Mono                  ;; Color-light    Color-dark      Gray-light      Gray-dark Mono
4703                (list 'font-lock-comment-face                  (list 'font-lock-comment-face
4704                      ["Firebrick"        "OrangeRed"     "DimGray"       "Gray80"]                        ["Firebrick"      "OrangeRed"     "DimGray"       "Gray80"]
4705                      nil                        nil
4706                      [nil                nil             t               t       t]                        [nil              nil             t               t       t]
4707                      [nil                nil             t               t       t]                        [nil              nil             t               t       t]
4708                      nil)                        nil)
4709                (list 'font-lock-string-face                  (list 'font-lock-string-face
4710                      ["RosyBrown"        "LightSalmon"   "Gray50"        "LightGray"]                        ["RosyBrown"      "LightSalmon"   "Gray50"        "LightGray"]
4711                      nil                        nil
4712                      nil                        nil
4713                      [nil                nil             t               t       t]                        [nil              nil             t               t       t]
4714                      nil)                        nil)
4715                (list 'font-lock-function-name-face                  (list 'font-lock-function-name-face
4716                      (vector                        (vector
4717                       "Blue"             "LightSkyBlue"  "Gray50"        "LightGray"                         "Blue"           "LightSkyBlue"  "Gray50"        "LightGray"
4718                       (cdr (assq 'background-color ; if mono                         (cdr (assq 'background-color ; if mono
4719                                  (frame-parameters))))                                    (frame-parameters))))
4720                      (vector                        (vector
4721                       nil                nil             nil             nil                         nil              nil             nil             nil
4722                       (cdr (assq 'foreground-color ; if mono                         (cdr (assq 'foreground-color ; if mono
4723                                  (frame-parameters))))                                    (frame-parameters))))
4724                      [nil                nil             t               t       t]                        [nil              nil             t               t       t]
4725                      nil                        nil
4726                      nil)                        nil)
4727                (list 'font-lock-variable-name-face                  (list 'font-lock-variable-name-face
4728                      ["DarkGoldenrod"    "LightGoldenrod" "DimGray"      "Gray90"]                        ["DarkGoldenrod"  "LightGoldenrod" "DimGray"      "Gray90"]
4729                      nil                        nil
4730                      [nil                nil             t               t       t]                        [nil              nil             t               t       t]
4731                      [nil                nil             t               t       t]                        [nil              nil             t               t       t]
4732                      nil)                        nil)
4733                (list 'font-lock-type-face                  (list 'font-lock-type-face
4734                      ["DarkOliveGreen"   "PaleGreen"     "DimGray"       "Gray80"]                        ["DarkOliveGreen" "PaleGreen"     "DimGray"       "Gray80"]
4735                      nil                        nil
4736                      [nil                nil             t               t       t]                        [nil              nil             t               t       t]
4737                      nil                        nil
4738                      [nil                nil             t               t       t]                        [nil              nil             t               t       t])
4739                      )                  (list 'font-lock-constant-face
4740                (list 'font-lock-constant-face                        ["CadetBlue"      "Aquamarine"    "Gray50"        "LightGray"]
4741                      ["CadetBlue"        "Aquamarine"    "Gray50"        "LightGray"]                        nil
4742                      nil                        [nil              nil             t               t       t]
4743                      [nil                nil             t               t       t]                        nil
4744                      nil                        [nil              nil             t               t       t])
4745                      [nil                nil             t               t       t]                  (list 'cperl-nonoverridable-face
4746                      )                        ["chartreuse3"    ("orchid1" "orange")
4747                (list 'cperl-nonoverridable-face                         nil              "Gray80"]
4748                      ["chartreuse3"      ("orchid1" "orange")                        [nil              nil             "gray90"]
4749                       nil                "Gray80"]                        [nil              nil             nil             t       t]
4750                      [nil                nil             "gray90"]                        [nil              nil             t               t]
4751                      [nil                nil             nil             t       t]                        [nil              nil             t               t       t])
4752                      [nil                nil             t               t]                  (list 'cperl-array-face
4753                      [nil                nil             t               t       t]                        ["blue"           "yellow"        nil             "Gray80"]
4754                      )                        ["lightyellow2"   ("navy" "os2blue" "darkgreen")
4755                (list 'cperl-array-face                         "gray90"]
4756                      ["blue"             "yellow"        nil             "Gray80"]                        t
4757                      ["lightyellow2"     ("navy" "os2blue" "darkgreen")                        nil
4758                       "gray90"]                        nil)
4759                      t                  (list 'cperl-hash-face
4760                      nil                        ["red"            "red"           nil             "Gray80"]
4761                      nil)                        ["lightyellow2"   ("navy" "os2blue" "darkgreen")
4762                (list 'cperl-hash-face                         "gray90"]
4763                      ["red"              "red"           nil             "Gray80"]                        t
4764                      ["lightyellow2"     ("navy" "os2blue" "darkgreen")                        t
4765                       "gray90"]                        nil))))
                     t  
                     t  
                     nil))))  
4766            ;; Do it the dull way, without choose-color            ;; Do it the dull way, without choose-color
4767            (defvar cperl-guessed-background nil            (defvar cperl-guessed-background nil
4768              "Display characteristics as guessed by cperl.")              "Display characteristics as guessed by cperl.")
4769  ;;        (or (fboundp 'x-color-defined-p)            ;;      (or (fboundp 'x-color-defined-p)
4770  ;;            (defalias 'x-color-defined-p            ;;          (defalias 'x-color-defined-p
4771  ;;              (cond ((fboundp 'color-defined-p) 'color-defined-p)            ;;            (cond ((fboundp 'color-defined-p) 'color-defined-p)
4772  ;;                    ;; XEmacs >= 19.12            ;;                  ;; XEmacs >= 19.12
4773  ;;                    ((fboundp 'valid-color-name-p) 'valid-color-name-p)            ;;                  ((fboundp 'valid-color-name-p) 'valid-color-name-p)
4774  ;;                    ;; XEmacs 19.11            ;;                  ;; XEmacs 19.11
4775  ;;                    (t 'x-valid-color-name-p))))            ;;                  (t 'x-valid-color-name-p))))
4776            (cperl-force-face font-lock-constant-face            (cperl-force-face font-lock-constant-face
4777                              "Face for constant and label names")                              "Face for constant and label names")
4778            (cperl-force-face font-lock-variable-name-face            (cperl-force-face font-lock-variable-name-face
# Line 4846  indentation and initial hashes.  Behaves Line 4839  indentation and initial hashes.  Behaves
4839                   (if (boundp 'font-lock-background-mode)                   (if (boundp 'font-lock-background-mode)
4840                       font-lock-background-mode                       font-lock-background-mode
4841                     'light))                     'light))
4842                  (face-list (and (fboundp 'face-list) (face-list)))                  (face-list (and (fboundp 'face-list) (face-list))))
                 ;; cperl-is-face  
                 )  
4843  ;;;;        (fset 'cperl-is-face  ;;;;        (fset 'cperl-is-face
4844  ;;;;              (cond ((fboundp 'find-face)  ;;;;              (cond ((fboundp 'find-face)
4845  ;;;;                     (symbol-function 'find-face))  ;;;;                     (symbol-function 'find-face))
# Line 4862  indentation and initial hashes.  Behaves Line 4853  indentation and initial hashes.  Behaves
4853                    'gray                    'gray
4854                  background)                  background)
4855                "Background as guessed by CPerl mode")                "Background as guessed by CPerl mode")
4856              (if (and              (and (not (cperl-is-face 'font-lock-constant-face))
4857                   (not (cperl-is-face 'font-lock-constant-face))                   (cperl-is-face 'font-lock-reference-face)
4858                   (cperl-is-face 'font-lock-reference-face))                   (copy-face 'font-lock-reference-face 'font-lock-constant-face))
               (copy-face 'font-lock-reference-face 'font-lock-constant-face))  
4859              (if (cperl-is-face 'font-lock-type-face) nil              (if (cperl-is-face 'font-lock-type-face) nil
4860                (copy-face 'default 'font-lock-type-face)                (copy-face 'default 'font-lock-type-face)
4861                (cond                (cond
# Line 5023  Style of printout regulated by the varia Line 5013  Style of printout regulated by the varia
5013      cperl-continued-statement-offset))      cperl-continued-statement-offset))
5014    
5015  (defconst cperl-style-alist  (defconst cperl-style-alist
5016    '(("CPerl" ; =GNU without extra-newline-before-brace    '(("CPerl"                         ; =GNU without extra-newline-before-brace
5017       (cperl-indent-level               .  2)       (cperl-indent-level               .  2)
5018       (cperl-brace-offset               .  0)       (cperl-brace-offset               .  0)
5019       (cperl-continued-brace-offset     .  0)       (cperl-continued-brace-offset     .  0)
# Line 5031  Style of printout regulated by the varia Line 5021  Style of printout regulated by the varia
5021       (cperl-extra-newline-before-brace .  nil)       (cperl-extra-newline-before-brace .  nil)
5022       (cperl-merge-trailing-else        .  t)       (cperl-merge-trailing-else        .  t)
5023       (cperl-continued-statement-offset .  2))       (cperl-continued-statement-offset .  2))
5024      ("PerlStyle" ; CPerl with 4 as indent      ("PerlStyle"                        ; CPerl with 4 as indent
5025       (cperl-indent-level               .  4)       (cperl-indent-level               .  4)
5026       (cperl-brace-offset               .  0)       (cperl-brace-offset               .  0)
5027       (cperl-continued-brace-offset     .  0)       (cperl-continued-brace-offset     .  0)
# Line 5093  data already), may be restored by `cperl Line 5083  data already), may be restored by `cperl
5083  Chosing \"Current\" style will not change style, so this may be used for  Chosing \"Current\" style will not change style, so this may be used for
5084  side-effect of memorizing only."  side-effect of memorizing only."
5085    (interactive    (interactive
5086     (let ((list (mapcar (function (lambda (elt) (list (car elt))))     (let ((list (mapcar (function (lambda (elt) (list (car elt))))
5087                         cperl-style-alist)))                         cperl-style-alist)))
5088       (list (completing-read "Enter style: " list nil 'insist))))       (list (completing-read "Enter style: " list nil 'insist))))
5089    (or cperl-old-style    (or cperl-old-style
# Line 5172  Customized by setting variables `cperl-s Line 5162  Customized by setting variables `cperl-s
5162    (interactive    (interactive
5163     (let* ((default (cperl-word-at-point))     (let* ((default (cperl-word-at-point))
5164            (read (read-string            (read (read-string
5165                       (format "Find doc for Perl function (default %s): "                   (format "Find doc for Perl function (default %s): "
5166                               default))))                           default))))
5167       (list (if (equal read "")       (list (if (equal read "")
5168                     default                 default
5169                   read))))               read))))
5170    
5171    (let ((buffer (current-buffer))    (let ((buffer (current-buffer))
5172          (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"          (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
# Line 5235  Customized by setting variables `cperl-s Line 5225  Customized by setting variables `cperl-s
5225                           ;; Non-functioning under OS/2:                           ;; Non-functioning under OS/2:
5226                           (if (eq char-height 1) (setq char-height 18))                           (if (eq char-height 1) (setq char-height 18))
5227                           ;; Title, menubar, + 2 for slack                           ;; Title, menubar, + 2 for slack
5228                           (- (/ (x-display-pixel-height) char-height) 4)                           (- (/ (x-display-pixel-height) char-height) 4)))
                          ))  
5229                   (if (> height max-height) (setq height max-height))                   (if (> height max-height) (setq height max-height))
5230                   ;;(message "was %s doing %s" iniheight height)                   ;;(message "was %s doing %s" iniheight height)
5231                   (if not-loner                   (if not-loner
# Line 5343  Will not move the position at the start Line 5332  Will not move the position at the start
5332              (setq e (point))              (setq e (point))
5333              (skip-chars-backward " \t")              (skip-chars-backward " \t")
5334              (delete-region (point) e)              (delete-region (point) e)
5335              (indent-to-column col); (make-string (- col (current-column)) ?\ ))              (indent-to-column col) ;(make-string (- col (current-column)) ?\ ))
5336              (beginning-of-line 2)              (beginning-of-line 2)
5337              (and (< (point) end)              (and (< (point) end)
5338                   (re-search-forward search end t)                   (re-search-forward search end t)
# Line 5458  See `cperl-lazy-help-time' too." Line 5447  See `cperl-lazy-help-time' too."
5447          (or noninteractive          (or noninteractive
5448              (imenu-progress-message prev-pos))              (imenu-progress-message prev-pos))
5449          (cond          (cond
5450           ((match-beginning 2)   ; SECTION           ((match-beginning 2)           ; SECTION
5451            (setq package (buffer-substring (match-beginning 2) (match-end 2)))            (setq package (buffer-substring (match-beginning 2) (match-end 2)))
5452            (goto-char (match-beginning 0))            (goto-char (match-beginning 0))
5453            (skip-chars-forward " \t")            (skip-chars-forward " \t")
# Line 5491  See `cperl-lazy-help-time' too." Line 5480  See `cperl-lazy-help-time' too."
5480  (defvar cperl-unreadable-ok nil)  (defvar cperl-unreadable-ok nil)
5481    
5482  (defun cperl-find-tags (ifile xs topdir)  (defun cperl-find-tags (ifile xs topdir)
5483    (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel    (let ((b (get-buffer cperl-tmp-buffer)) ind lst elt pos ret rel
5484              (cperl-pod-here-fontify nil) f file)          (cperl-pod-here-fontify nil) f file)
5485      (save-excursion      (save-excursion
5486        (if b (set-buffer b)        (if b (set-buffer b)
5487            (cperl-setup-tmp-buf))          (cperl-setup-tmp-buf))
5488        (erase-buffer)        (erase-buffer)
5489        (condition-case err        (condition-case err
5490            (setq file (car (insert-file-contents ifile)))            (setq file (car (insert-file-contents ifile)))
# Line 5506  See `cperl-lazy-help-time' too." Line 5495  See `cperl-lazy-help-time' too."
5495                     (error "Aborting: unreadable file %s" ifile)))))                     (error "Aborting: unreadable file %s" ifile)))))
5496        (if (not file)        (if (not file)
5497            (message "Unreadable file %s" ifile)            (message "Unreadable file %s" ifile)
5498        (message "Scanning file %s ..." file)          (message "Scanning file %s ..." file)
5499        (if (and cperl-use-syntax-table-text-property-for-tags          (if (and cperl-use-syntax-table-text-property-for-tags
5500                 (not xs))                   (not xs))
5501            (condition-case err           ; after __END__ may have garbage              (condition-case err         ; after __END__ may have garbage
5502                (cperl-find-pods-heres nil nil noninteractive)                  (cperl-find-pods-heres nil nil noninteractive)
5503              (error (message "While scanning for syntax: %s" err))))                (error (message "While scanning for syntax: %s" err))))
5504        (if xs          (if xs
5505            (setq lst (cperl-xsub-scan))              (setq lst (cperl-xsub-scan))
5506          (setq ind (cperl-imenu--create-perl-index))            (setq ind (cperl-imenu--create-perl-index))
5507          (setq lst (cdr (assoc "+Unsorted List+..." ind))))            (setq lst (cdr (assoc "+Unsorted List+..." ind))))
5508        (setq lst          (setq lst
5509              (mapcar                (mapcar
5510               (function                 (function
5511                (lambda (elt)                  (lambda (elt)
5512                  (cond ((string-match "^[_a-zA-Z]" (car elt))                    (cond ((string-match "^[_a-zA-Z]" (car elt))
5513                         (goto-char (cdr elt))                           (goto-char (cdr elt))
5514                         (beginning-of-line) ; pos should be of the start of the line                           (beginning-of-line) ; pos should be of the start of the line
5515                         (list (car elt)                           (list (car elt)
5516                               (point)                                 (point)
5517                               (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l                                 (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
5518                               (buffer-substring (progn                                 (buffer-substring (progn
5519                                                   (goto-char (cdr elt))                                                     (goto-char (cdr elt))
5520                                                   ;; After name now...                                                     ;; After name now...
5521                                                   (or (eolp) (forward-char 1))                                                     (or (eolp) (forward-char 1))
5522                                                   (point))                                                     (point))
5523                                                 (progn                                                   (progn
5524                                                   (beginning-of-line)                                                     (beginning-of-line)
5525                                                   (point))))))))                                                     (point))))))))
5526                      lst))                 lst))
5527        (erase-buffer)          (erase-buffer)
5528        (while lst          (while lst
5529          (setq elt (car lst) lst (cdr lst))            (setq elt (car lst) lst (cdr lst))
5530          (if elt            (if elt
5531              (progn                (progn
5532                (insert (elt elt 3)                  (insert (elt elt 3)
5533                        127                          127
5534                        (if (string-match "^package " (car elt))                          (if (string-match "^package " (car elt))
5535                            (substring (car elt) 8)                              (substring (car elt) 8)
5536                          (car elt) )                            (car elt) )
5537                        1                          1
5538                        (number-to-string (elt elt 2)) ; Line                          (number-to-string (elt elt 2)) ; Line
5539                        ","                          ","
5540                        (number-to-string (1- (elt elt 1))) ; Char pos 0-based                          (number-to-string (1- (elt elt 1))) ; Char pos 0-based
5541                        "\n")                          "\n")
5542                (if (and (string-match "^[_a-zA-Z]+::" (car elt))                  (if (and (string-match "^[_a-zA-Z]+::" (car elt))
5543                         (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]"                           (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]"
5544                                       (elt elt 3)))                                         (elt elt 3)))
5545                    ;; Need to insert the name without package as well                      ;; Need to insert the name without package as well
5546                    (setq lst (cons (cons (substring (elt elt 3)                      (setq lst (cons (cons (substring (elt elt 3)
5547                                                     (match-beginning 1)                                                       (match-beginning 1)
5548                                                     (match-end 1))                                                       (match-end 1))
5549                                          (cdr elt))                                            (cdr elt))
5550                                    lst))))))                                      lst))))))
5551        (setq pos (point))          (setq pos (point))
5552        (goto-char 1)          (goto-char 1)
5553        (setq rel file)          (setq rel file)
5554        ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties          ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
5555        (set-text-properties 0 (length rel) nil rel)          (set-text-properties 0 (length rel) nil rel)
5556        (and (equal topdir (substring rel 0 (length topdir)))          (and (equal topdir (substring rel 0 (length topdir)))
5557             (setq rel (substring file (length topdir))))               (setq rel (substring file (length topdir))))
5558        (insert "\f\n" rel "," (number-to-string (1- pos)) "\n")          (insert "\f\n" rel "," (number-to-string (1- pos)) "\n")
5559        (setq ret (buffer-substring 1 (point-max)))          (setq ret (buffer-substring 1 (point-max)))
5560        (erase-buffer)          (erase-buffer)
5561        (or noninteractive          (or noninteractive
5562            (message "Scanning file %s finished" file))              (message "Scanning file %s finished" file))
5563        ret))))          ret))))
5564    
5565  (defun cperl-add-tags-recurse-noxs ()  (defun cperl-add-tags-recurse-noxs ()
5566    "Add to TAGS data for Perl and XSUB files in the current directory and kids.    "Add to TAGS data for Perl and XSUB files in the current directory and kids.
# Line 5606  Use as Line 5595  Use as
5595              ((file-exists-p tags-file-name)              ((file-exists-p tags-file-name)
5596               (if cperl-xemacs-p               (if cperl-xemacs-p
5597                   (visit-tags-table-buffer)                   (visit-tags-table-buffer)
5598                (visit-tags-table-buffer tags-file-name)))                 (visit-tags-table-buffer tags-file-name)))
5599              (t (set-buffer (find-file-noselect tags-file-name))))              (t (set-buffer (find-file-noselect tags-file-name))))
5600        (cond        (cond
5601         (dir         (dir
# Line 5624  Use as Line 5613  Use as
5613                      (if (y-or-n-p                      (if (y-or-n-p
5614                           (format "Directory %s unreadable.  Continue? " file))                           (format "Directory %s unreadable.  Continue? " file))
5615                          (setq cperl-unreadable-ok t                          (setq cperl-unreadable-ok t
5616                                tm nil) ; Return empty list                                tm nil)   ; Return empty list
5617                        (error "Aborting: unreadable directory %s" file)))))))                        (error "Aborting: unreadable directory %s" file)))))))
5618            (mapcar (function (lambda (file)            (mapcar (function
5619                                (cond                     (lambda (file)
5620                                 ((string-match cperl-noscan-files-regexp file)                       (cond
5621                                  nil)                        ((string-match cperl-noscan-files-regexp file)
5622                                 ((not (file-directory-p file))                         nil)
5623                                  (if (string-match cperl-scan-files-regexp file)                        ((not (file-directory-p file))
5624                                      (cperl-write-tags file erase recurse nil t noxs topdir)))                         (if (string-match cperl-scan-files-regexp file)
5625                                 ((not recurse) nil)                             (cperl-write-tags file erase recurse nil t noxs topdir)))
5626                                 (t (cperl-write-tags file erase recurse t t noxs topdir)))))                        ((not recurse) nil)
5627                    files))                        (t (cperl-write-tags file erase recurse t t noxs topdir)))))
5628          )                    files)))
5629         (t         (t
5630          (setq xs (string-match "\\.xs$" file))          (setq xs (string-match "\\.xs$" file))
5631          (if (not (and xs noxs))          (if (not (and xs noxs))
5632              (progn              (progn
5633                (cond ((eq erase 'ignore) (goto-char (point-max)))                (cond ((eq erase 'ignore) (goto-char (point-max)))
5634                    (erase (erase-buffer))                      (erase (erase-buffer))
5635                    (t                      (t
5636                     (goto-char 1)                       (goto-char 1)
5637                     (setq rel file)                       (setq rel file)
5638                     ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties                       ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
5639                     (set-text-properties 0 (length rel) nil rel)                       (set-text-properties 0 (length rel) nil rel)
5640                     (and (equal topdir (substring rel 0 (length topdir)))                       (and (equal topdir (substring rel 0 (length topdir)))
5641                          (setq rel (substring file (length topdir))))                            (setq rel (substring file (length topdir))))
5642                     (if (search-forward (concat "\f\n" rel ",") nil t)                       (if (search-forward (concat "\f\n" rel ",") nil t)
5643                         (progn                           (progn
5644                           (search-backward "\f\n")                             (search-backward "\f\n")
5645                           (delete-region (point)                             (delete-region (point)
5646                                          (save-excursion                                            (save-excursion
5647                                            (forward-char 1)                                              (forward-char 1)
5648                                            (if (search-forward "\f\n"                                              (if (search-forward "\f\n"
5649                                                                nil 'toend)                                                                  nil 'toend)
5650                                                (- (point) 2)                                                  (- (point) 2)
5651                                              (point-max)))))                                                (point-max)))))
5652                       (goto-char (point-max)))))                         (goto-char (point-max)))))
5653                (insert (cperl-find-tags file xs topdir))))))                (insert (cperl-find-tags file xs topdir))))))
5654        (if inbuffer nil          ; Delegate to the caller        (if inbuffer nil                  ; Delegate to the caller
5655          (save-buffer 0)         ; No backup          (save-buffer 0)                 ; No backup
5656          (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?          (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
5657              (initialize-new-tags-table))))))              (initialize-new-tags-table))))))
5658    
# Line 5733  One may build such TAGS files from CPerl Line 5722  One may build such TAGS files from CPerl
5722    (require 'etags)    (require 'etags)
5723    (require 'imenu)    (require 'imenu)
5724    (if (or update (null (nth 2 cperl-hierarchy)))    (if (or update (null (nth 2 cperl-hierarchy)))
5725        (let (pack name cons1 to l1 l2 l3 l4 b        (let ((remover (function (lambda (elt) ; (name (file1...) (file2..))
5726                   (remover (function (lambda (elt) ; (name (file1...) (file2..))                                   (or (nthcdr 2 elt)
5727                                        (or (nthcdr 2 elt)                                       ;; Only in one file
5728                                            ;; Only in one file                                       (setcdr elt (cdr (nth 1 elt)))))))
5729                                            (setcdr elt (cdr (nth 1 elt))))))))              pack name cons1 to l1 l2 l3 l4 b)
5730          ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!          ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
5731          (setq cperl-hierarchy (list l1 l2 l3))          (setq cperl-hierarchy (list l1 l2 l3))
5732          (if cperl-xemacs-p              ; Not checked          (if cperl-xemacs-p              ; Not checked
# Line 5772  One may build such TAGS files from CPerl Line 5761  One may build such TAGS files from CPerl
5761        (error "No items found"))        (error "No items found"))
5762    (setq update    (setq update
5763  ;;;     (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))  ;;;     (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))
5764          (if window-system          (if (if (fboundp 'display-popup-menus-p)
5765                    (let ((f 'display-popup-menus-p))
5766                      (funcall f))
5767                  window-system)
5768              (x-popup-menu t (nth 2 cperl-hierarchy))              (x-popup-menu t (nth 2 cperl-hierarchy))
5769            (require 'tmm)            (require 'tmm)
5770            (tmm-prompt (nth 2 cperl-hierarchy))))            (tmm-prompt (nth 2 cperl-hierarchy))))
# Line 5853  One may build such TAGS files from CPerl Line 5845  One may build such TAGS files from CPerl
5845              (if (default-value 'imenu-sort-function)              (if (default-value 'imenu-sort-function)
5846                  (nreverse                  (nreverse
5847                   (sort root-packages (default-value 'imenu-sort-function)))                   (sort root-packages (default-value 'imenu-sort-function)))
5848                root-packages))                root-packages))))
     ))  
5849    
5850  ;;;(x-popup-menu t  ;;;(x-popup-menu t
5851  ;;;   '(keymap "Name1"  ;;;   '(keymap "Name1"
# Line 5901  One may build such TAGS files from CPerl Line 5892  One may build such TAGS files from CPerl
5892    
5893  (defvar cperl-bad-style-regexp  (defvar cperl-bad-style-regexp
5894    (mapconcat 'identity    (mapconcat 'identity
5895     '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign               '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign
5896       "[-<>=+^&|]+[^- \t\n=+<>~]"        ; sign+ char                 "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char
5897       )               "\\|")
    "\\|")  
5898    "Finds places such that insertion of a whitespace may help a lot.")    "Finds places such that insertion of a whitespace may help a lot.")
5899    
5900  (defvar cperl-not-bad-style-regexp  (defvar cperl-not-bad-style-regexp
5901    (mapconcat 'identity    (mapconcat
5902       'identity
5903     '("[^-\t <>=+]\\(--\\|\\+\\+\\)"     ; var-- var++     '("[^-\t <>=+]\\(--\\|\\+\\+\\)"     ; var-- var++
5904       "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]"    ; abc|def abc&def are often used.       "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]"    ; abc|def abc&def are often used.
5905       "&[(a-zA-Z0-9_$]"                  ; &subroutine &(var->field)       "&[(a-zA-Z0-9_$]"                  ; &subroutine &(var->field)
# Line 5927  One may build such TAGS files from CPerl Line 5918  One may build such TAGS files from CPerl
5918       "||"       "||"
5919       "&&"       "&&"
5920       "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>       "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>
5921       "-[a-zA-Z_0-9]+[ \t]*=>"                   ; -option => value       "-[a-zA-Z_0-9]+[ \t]*=>"           ; -option => value
5922       ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below       ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below
5923       ;;"[*/+-|&<.]+="       ;;"[*/+-|&<.]+="
5924       )       )
# Line 5946  Currently it is tuned to C and Perl synt Line 5937  Currently it is tuned to C and Perl synt
5937      (setq last-nonmenu-event 13)        ; To disable popup      (setq last-nonmenu-event 13)        ; To disable popup
5938      (beginning-of-buffer)      (beginning-of-buffer)
5939      (map-y-or-n-p "Insert space here? "      (map-y-or-n-p "Insert space here? "
5940                    (function (lambda (arg) (insert " ")))                    (lambda (arg) (insert " "))
5941                    'cperl-next-bad-style                    'cperl-next-bad-style
5942                    '("location" "locations" "insert a space into")                    '("location" "locations" "insert a space into")
5943                    '((?\C-r (lambda (arg)                    '((?\C-r (lambda (arg)
# Line 5999  Currently it is tuned to C and Perl synt Line 5990  Currently it is tuned to C and Perl synt
5990    ;;(concat "\\("    ;;(concat "\\("
5991    (mapconcat    (mapconcat
5992     'identity     'identity
5993     '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?"           ; Usual variable     '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable
5994       "[$@]\\^[a-zA-Z]"                  ; Special variable       "[$@]\\^[a-zA-Z]"                  ; Special variable
5995       "[$@][^ \n\t]"                     ; Special variable       "[$@][^ \n\t]"                     ; Special variable
5996       "-[a-zA-Z]"                        ; File test       "-[a-zA-Z]"                        ; File test
5997       "\\\\[a-zA-Z0]"                    ; Special chars       "\\\\[a-zA-Z0]"                    ; Special chars
5998       "^=[a-z][a-zA-Z0-9_]*"             ; Pod sections       "^=[a-z][a-zA-Z0-9_]*"             ; POD sections
5999       "[-!&*+,-./<=>?\\\\^|~]+"          ; Operator       "[-!&*+,-./<=>?\\\\^|~]+"          ; Operator
6000       "[a-zA-Z_0-9:]+"                   ; symbol or number       "[a-zA-Z_0-9:]+"                   ; symbol or number
6001       "x="       "x="
6002       "#!"       "#!")
      )  
6003     ;;"\\)\\|\\("     ;;"\\)\\|\\("
6004     "\\|"     "\\|")
6005     )    ;;"\\)"
6006            ;;"\\)"    ;;)
           ;;)  
6007    "Matches places in the buffer we can find help for.")    "Matches places in the buffer we can find help for.")
6008    
6009  (defvar cperl-message-on-help-error t)  (defvar cperl-message-on-help-error t)
# Line 6102  than a line.  Your contribution to updat Line 6091  than a line.  Your contribution to updat
6091    (let ((enable-recursive-minibuffers t)    (let ((enable-recursive-minibuffers t)
6092          args-file regexp)          args-file regexp)
6093      (cond      (cond
6094          ((string-match "^[&*][a-zA-Z_]" val)       ((string-match "^[&*][a-zA-Z_]" val)
6095           (setq val (concat (substring val 0 1) "NAME")))        (setq val (concat (substring val 0 1) "NAME")))
6096          ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val)       ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val)
6097           (setq val (concat "@" (substring val 1 (match-end 1)))))        (setq val (concat "@" (substring val 1 (match-end 1)))))
6098          ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val)       ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val)
6099           (setq val (concat "%" (substring val 1 (match-end 1)))))        (setq val (concat "%" (substring val 1 (match-end 1)))))
6100          ((and (string= val "x") (string-match "^x=" val))       ((and (string= val "x") (string-match "^x=" val))
6101           (setq val "x="))        (setq val "x="))
6102          ((string-match "^\\$[\C-a-\C-z]" val)       ((string-match "^\\$[\C-a-\C-z]" val)
6103           (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1))))))        (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1))))))
6104          ((string-match "^CORE::" val)       ((string-match "^CORE::" val)
6105           (setq val "CORE::"))        (setq val "CORE::"))
6106          ((string-match "^SUPER::" val)       ((string-match "^SUPER::" val)
6107           (setq val "SUPER::"))        (setq val "SUPER::"))
6108          ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val))       ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val))
6109           (setq val "<NAME>")))        (setq val "<NAME>")))
6110      (setq regexp (concat "^"      (setq regexp (concat "^"
6111                           "\\([^a-zA-Z0-9_:]+[ \t]+\\)?"                           "\\([^a-zA-Z0-9_:]+[ \t]+\\)?"
6112                           (regexp-quote val)                           (regexp-quote val)
# Line 6139  than a line.  Your contribution to updat Line 6128  than a line.  Your contribution to updat
6128           (if cperl-message-on-help-error           (if cperl-message-on-help-error
6129               (message "No definition for %s" val)))))))               (message "No definition for %s" val)))))))
6130    
6131  (defvar cperl-short-docs "Ignore my value"  (defvar cperl-short-docs 'please-ignore-this-line
6132    ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)    ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)
6133    "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]    "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
6134  ! ...   Logical negation.  ! ...   Logical negation.
# Line 6525  chomp [LIST]   Strips $/ off LIST/$_.  Ret Line 6514  chomp [LIST]   Strips $/ off LIST/$_.  Ret
6514  chr             Converts a number to char with the same ordinal.  chr             Converts a number to char with the same ordinal.
6515  else            Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.  else            Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
6516  elsif           Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.  elsif           Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
6517  exists  $HASH{KEY}      True if the key exists.  exists $HASH{KEY}       True if the key exists.
6518  format [NAME] =  Start of output format.  Ended by a single dot (.) on a line.  format [NAME] =  Start of output format.  Ended by a single dot (.) on a line.
6519  formline PICTURE, LIST  Backdoor into \"format\" processing.  formline PICTURE, LIST  Backdoor into \"format\" processing.
6520  glob EXPR       Synonym of <EXPR>.  glob EXPR       Synonym of <EXPR>.
# Line 6603  prototype \&SUB        Returns prototype of the Line 6592  prototype \&SUB        Returns prototype of the
6592      (goto-char e)      (goto-char e)
6593      (beginning-of-line)      (beginning-of-line)
6594      (if (re-search-forward "[^ \t]" e t)      (if (re-search-forward "[^ \t]" e t)
6595          (progn                          ; Something before the ending delimiter          (progn                         ; Something before the ending delimiter
6596            (goto-char e)            (goto-char e)
6597            (delete-horizontal-space)            (delete-horizontal-space)
6598            (insert "\n")            (insert "\n")
# Line 6633  prototype \&SUB        Returns prototype of the Line 6622  prototype \&SUB        Returns prototype of the
6622                         "\\|"            ; Grouping                         "\\|"            ; Grouping
6623                         "\\((\\(\\?\\)?\\)" ; 7 8                         "\\((\\(\\?\\)?\\)" ; 7 8
6624                         "\\|"            ; |                         "\\|"            ; |
6625                         "\\(|\\)"        ; 9                         "\\(|\\)")))     ; 9
                        )))  
6626          (goto-char (match-end 0))          (goto-char (match-end 0))
6627          (setq spaces t)          (setq spaces t)
6628          (cond ((match-beginning 1)      ; Alphanum word + junk          (cond ((match-beginning 1)      ; Alphanum word + junk
# Line 6744  prototype \&SUB        Returns prototype of the Line 6732  prototype \&SUB        Returns prototype of the
6732              (not spaces)              (not spaces)
6733              (insert " "))              (insert " "))
6734          (skip-chars-forward " \t"))          (skip-chars-forward " \t"))
6735          (or (looking-at "[#\n]")        (or (looking-at "[#\n]")
6736              (error "Unknown code `%s' in a regexp"            (error "Unknown code `%s' in a regexp"
6737                     (buffer-substring (point) (1+ (point)))))                   (buffer-substring (point) (1+ (point)))))
6738          (and inline (end-of-line 2)))        (and inline (end-of-line 2)))
6739      ;; Special-case the last line of group      ;; Special-case the last line of group
6740      (if (and (>= (point) (marker-position e))      (if (and (>= (point) (marker-position e))
6741               (/= (current-indentation) c))               (/= (current-indentation) c))
6742          (progn          (progn
6743           (beginning-of-line)            (beginning-of-line)
6744           (setq s (point))            (setq s (point))
6745           (skip-chars-forward " \t")            (skip-chars-forward " \t")
6746           (delete-region s (point))            (delete-region s (point))
6747           (indent-to-column c)))            (indent-to-column c)))))
   ))  
6748    
6749  (defun cperl-make-regexp-x ()  (defun cperl-make-regexp-x ()
6750    ;; Returns position of the start    ;; Returns position of the start
# Line 6770  prototype \&SUB        Returns prototype of the Line 6757  prototype \&SUB        Returns prototype of the
6757          nil                             ; good already          nil                             ; good already
6758        (if (looking-at "\\([smy]\\|qr\\)\\s|")        (if (looking-at "\\([smy]\\|qr\\)\\s|")
6759            (forward-char 1)            (forward-char 1)
6760          (re-search-backward "\\s|")))           ; Assume it is scanned already.          (re-search-backward "\\s|")))   ; Assume it is scanned already.
6761      ;;(forward-char 1)      ;;(forward-char 1)
6762      (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))      (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
6763            (sub-p (eq (preceding-char) ?s)) s)            (sub-p (eq (preceding-char) ?s)) s)
# Line 6825  We suppose that the regexp is scanned al Line 6812  We suppose that the regexp is scanned al
6812  We suppose that the regexp is scanned already."  We suppose that the regexp is scanned already."
6813    (interactive)    (interactive)
6814    ;; (save-excursion            ; Can't, breaks `cperl-contract-levels'    ;; (save-excursion            ; Can't, breaks `cperl-contract-levels'
6815      (cperl-regext-to-level-start)    (cperl-regext-to-level-start)
6816      (let ((b (point)) (e (make-marker)) s c)    (let ((b (point)) (e (make-marker)) s c)
6817        (forward-sexp 1)      (forward-sexp 1)
6818        (set-marker e (1- (point)))      (set-marker e (1- (point)))
6819        (goto-char b)      (goto-char b)
6820        (while (re-search-forward "\\(#\\)\\|\n" e 'to-end)      (while (re-search-forward "\\(#\\)\\|\n" e 'to-end)
6821          (cond        (cond
6822           ((match-beginning 1)           ; #-comment         ((match-beginning 1)             ; #-comment
6823            (or c (setq c (current-indentation)))          (or c (setq c (current-indentation)))
6824            (beginning-of-line 2)         ; Skip          (beginning-of-line 2)           ; Skip
6825            (setq s (point))          (setq s (point))
6826            (skip-chars-forward " \t")          (skip-chars-forward " \t")
6827            (delete-region s (point))          (delete-region s (point))
6828            (indent-to-column c))          (indent-to-column c))
6829           (t         (t
6830            (delete-char -1)          (delete-char -1)
6831            (just-one-space))))))          (just-one-space))))))
6832    
6833  (defun cperl-contract-levels ()  (defun cperl-contract-levels ()
6834    "Find an enclosing group in regexp and contract all the kids.    "Find an enclosing group in regexp and contract all the kids.
# Line 6881  We suppose that the regexp is scanned al Line 6868  We suppose that the regexp is scanned al
6868    "Change `if (A) {B}' into `B if A;' etc if possible."    "Change `if (A) {B}' into `B if A;' etc if possible."
6869    (interactive)    (interactive)
6870    (or (looking-at "\\<")    (or (looking-at "\\<")
6871          (forward-sexp -1))        (forward-sexp -1))
6872    (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>")    (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>")
6873        (let ((pos1 (point))        (let ((pos1 (point))
6874              pos2 pos3 pos4 pos5 s1 s2 state p pos45              pos2 pos3 pos4 pos5 s1 s2 state p pos45
# Line 7069  We suppose that the regexp is scanned al Line 7056  We suppose that the regexp is scanned al
7056          (setq cperl-help-shown nil))          (setq cperl-help-shown nil))
7057    
7058        (defun cperl-get-help-defer ()        (defun cperl-get-help-defer ()
7059          (when (memq major-mode '(perl-mode cperl-mode))          (if (not (memq major-mode '(perl-mode cperl-mode))) nil
7060            (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))            (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))
7061              (cperl-get-help)              (cperl-get-help)
7062              (setq cperl-help-shown t))))              (setq cperl-help-shown t))))
# Line 7091  We suppose that the regexp is scanned al Line 7078  We suppose that the regexp is scanned al
7078  (defun cperl-fontify-syntaxically (end)  (defun cperl-fontify-syntaxically (end)
7079    ;; Some vars for debugging only    ;; Some vars for debugging only
7080    ;; (message "Syntaxifying...")    ;; (message "Syntaxifying...")
7081    (let (start (dbg (point)) (iend end)    (let ((dbg (point)) (iend end)
7082          (istate (car cperl-syntax-state)))          (istate (car cperl-syntax-state))
7083            start)
7084      (and cperl-syntaxify-unwind      (and cperl-syntaxify-unwind
7085           (setq end (cperl-unwind-to-safe t end)))           (setq end (cperl-unwind-to-safe t end)))
7086      (setq start (point))      (setq start (point))
# Line 7113  We suppose that the regexp is scanned al Line 7101  We suppose that the regexp is scanned al
7101                   dbg iend                   dbg iend
7102                   start end cperl-syntax-done-to                   start end cperl-syntax-done-to
7103                   istate (car cperl-syntax-state))) ; For debugging                   istate (car cperl-syntax-state))) ; For debugging
7104      nil))                                       ; Do not iterate      nil))                               ; Do not iterate
7105    
7106  (defun cperl-fontify-update (end)  (defun cperl-fontify-update (end)
7107    (let ((pos (point)) prop posend)    (let ((pos (point)) prop posend)
# Line 7122  We suppose that the regexp is scanned al Line 7110  We suppose that the regexp is scanned al
7110        (setq posend (next-single-property-change pos 'cperl-postpone nil end))        (setq posend (next-single-property-change pos 'cperl-postpone nil end))
7111        (and prop (put-text-property pos posend (car prop) (cdr prop)))        (and prop (put-text-property pos posend (car prop) (cdr prop)))
7112        (setq pos posend)))        (setq pos posend)))
7113    nil)                          ; Do not iterate    nil)                                  ; Do not iterate
7114    
7115  (defun cperl-update-syntaxification (from to)  (defun cperl-update-syntaxification (from to)
7116    (if (and cperl-use-syntax-table-text-property    (if (and cperl-use-syntax-table-text-property
# Line 7135  We suppose that the regexp is scanned al Line 7123  We suppose that the regexp is scanned al
7123            (cperl-fontify-syntaxically to)))))            (cperl-fontify-syntaxically to)))))
7124    
7125  (defvar cperl-version  (defvar cperl-version
7126    (let ((v  "Revision: 4.32"))    (let ((v  "Revision: 4.35"))
7127      (string-match ":\\s *\\([0-9.]+\\)" v)      (string-match ":\\s *\\([0-9.]+\\)" v)
7128      (substring v (match-beginning 1) (match-end 1)))      (substring v (match-beginning 1) (match-end 1)))
7129    "Version of IZ-supported CPerl package this file is based on.")    "Version of IZ-supported CPerl package this file is based on.")

Legend:
Removed from v.1.41  
changed lines
  Added in v.1.42

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26