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. |
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)) |
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 |
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 |
|
|
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) |
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 |
|
|
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) |
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) |
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 |
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 |
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 |
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 |
|
|
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. |
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 |
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: |
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 |
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) |
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)) |
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] |
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" |
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. |
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 |
|
|
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)) |
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 |
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)) |
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 |
|
|
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 |
|
|
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 |
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 |
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 |
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 |
|
|
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 "$") |
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 |
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) |
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) |
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) |
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 |
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 |
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) |
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)) |
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: |
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) |
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)) |
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)) |
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))) |
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: |
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 |
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: |
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) |
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) |
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> |
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) |
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 }. |
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) |
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)) |
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 |
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) |
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)) |
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 |
|
|
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. |
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 |
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) |
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 |
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 |
|
|
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 |
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 () ;" |
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))) |
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)) |
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 () |
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.") |
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 |
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)) ?%) |
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 |
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)) |
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 |
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) |
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) |
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 |
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///" |
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 |
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) |
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") |
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))) |
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. |
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 |
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 |
|
|
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 |
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)))) |
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" |
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) |
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 |
) |
) |
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) |
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) |
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) |
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. |
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>. |
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") |
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 |
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 |
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) |
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. |
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 |
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)))) |
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)) |
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) |
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 |
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.") |