|
0
|
1 ;;; This code started from the following message of long time ago (IZ):
|
|
|
2
|
|
|
3 ;;; From: olson@mcs.anl.gov (Bob Olson)
|
|
|
4 ;;; Newsgroups: comp.lang.perl
|
|
|
5 ;;; Subject: cperl-mode: Another perl mode for Gnuemacs
|
|
|
6 ;;; Date: 14 Aug 91 15:20:01 GMT
|
|
|
7
|
|
|
8 ;; Perl code editing commands for Emacs
|
|
|
9 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
|
|
|
10
|
|
|
11 ;; This file is not (yet) part of GNU Emacs.
|
|
|
12
|
|
|
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
14 ;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;; any later version.
|
|
|
17
|
|
|
18 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;; GNU General Public License for more details.
|
|
|
22
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
26
|
|
|
27 ;;; Synched up with: Not in FSF.
|
|
|
28
|
|
|
29 ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
|
|
|
30 ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
|
|
|
31
|
|
|
32 ;; $Id: cperl-mode.el,v 1.1.1.1 1996/12/18 03:31:06 steve Exp $
|
|
|
33
|
|
|
34 ;;; To use this mode put the following into your .emacs file:
|
|
|
35
|
|
|
36 ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
|
|
|
37
|
|
|
38 ;;; You can either fine-tune the bells and whistles of this mode or
|
|
|
39 ;;; bulk enable them by putting
|
|
|
40
|
|
|
41 ;; (setq cperl-hairy t)
|
|
|
42
|
|
|
43 ;;; in your .emacs file. (Emacs rulers do not consider it politically
|
|
|
44 ;;; correct to make whistles enabled by default.)
|
|
|
45
|
|
|
46 ;;; Additional useful commands to put into your .emacs file:
|
|
|
47
|
|
|
48 ;; (setq auto-mode-alist
|
|
|
49 ;; (append '(("\\.[pP][Llm]$" . perl-mode)) auto-mode-alist ))
|
|
|
50 ;; (setq interpreter-mode-alist (append interpreter-mode-alist
|
|
|
51 ;; '(("miniperl" . perl-mode))))
|
|
|
52
|
|
|
53 ;;; The mode information (on C-h m) provides customization help.
|
|
|
54 ;;; If you use font-lock feature of this mode, it is advisable to use
|
|
|
55 ;;; eather lazy-lock-mode or fast-lock-mode (available on ELisp
|
|
|
56 ;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock.
|
|
|
57
|
|
|
58 ;;; Faces used now: three faces for first-class and second-class keywords
|
|
|
59 ;;; and control flow words, one for each: comments, string, labels,
|
|
|
60 ;;; functions definitions and packages, arrays, hashes, and variable
|
|
|
61 ;;; definitions. If you do not see all these faces, your font-lock does
|
|
|
62 ;;; not define them, so you need to define them manually. Maybe you have
|
|
|
63 ;;; an obsolete font-lock from 19.28 or earlier. Upgrade.
|
|
|
64
|
|
|
65 ;;; If you have grayscale monitor, and do not have the variable
|
|
|
66 ;;; font-lock-display-type bound to 'grayscale, insert
|
|
|
67
|
|
|
68 ;;; (setq font-lock-display-type 'grayscale)
|
|
|
69
|
|
|
70 ;;; to your .emacs file.
|
|
|
71
|
|
|
72 ;;;; This mode supports font-lock, imenu and mode-compile. In the
|
|
|
73 ;;;; hairy version font-lock is on, but you should activate imenu
|
|
|
74 ;;;; yourself (note that mode-compile is not standard yet). Well, you
|
|
|
75 ;;;; can use imenu from keyboard anyway (M-x imenu), but it is better
|
|
|
76 ;;;; to bind it like that:
|
|
|
77
|
|
|
78 ;; (define-key global-map [M-S-down-mouse-3] 'imenu)
|
|
|
79
|
|
|
80 ;;; In fact the version of font-lock that this version supports can be
|
|
|
81 ;;; much newer than the version you actually have. This means that a
|
|
|
82 ;;; lot of faces can be set up, but are not visible on your screen
|
|
|
83 ;;; since the coloring rules for this faces are not defined.
|
|
|
84
|
|
|
85 ;;; Updates: ========================================
|
|
|
86
|
|
|
87 ;;; Made less hairy by default: parentheses not electric,
|
|
|
88 ;;; linefeed not magic. Bug with abbrev-mode corrected.
|
|
|
89
|
|
|
90 ;;;; After 1.4:
|
|
|
91 ;;; Better indentation:
|
|
|
92 ;;; subs inside braces should work now,
|
|
|
93 ;;; Toplevel braces obey customization.
|
|
|
94 ;;; indent-for-comment knows about bad cases, cperl-indent-for-comment
|
|
|
95 ;;; moves cursor to a correct place.
|
|
|
96 ;;; cperl-indent-exp written from the scratch! Slow... (quadratic!) :-(
|
|
|
97 ;;; (50 secs on DB::DB (sub of 430 lines), 486/66)
|
|
|
98 ;;; Minor documentation fixes.
|
|
|
99 ;;; Imenu understands packages as prefixes (including nested).
|
|
|
100 ;;; Hairy options can be switched off one-by-one by setting to null.
|
|
|
101 ;;; Names of functions and variables changed to conform to `cperl-' style.
|
|
|
102
|
|
|
103 ;;;; After 1.5:
|
|
|
104 ;;; Some bugs with indentation of labels (and embedded subs) corrected.
|
|
|
105 ;;; `cperl-indent-region' done (slow :-()).
|
|
|
106 ;;; `cperl-fill-paragraph' done.
|
|
|
107 ;;; Better package support for `imenu'.
|
|
|
108 ;;; Progress indicator for indentation (with `imenu' loaded).
|
|
|
109 ;;; `Cperl-set' was busted, now setting the individual hairy option
|
|
|
110 ;;; should be better.
|
|
|
111
|
|
|
112 ;;;; After 1.6:
|
|
|
113 ;;; `cperl-set-style' done.
|
|
|
114 ;;; `cperl-check-syntax' done.
|
|
|
115 ;;; Menu done.
|
|
|
116 ;;; New config variables `cperl-close-paren-offset' and `cperl-comment-column'.
|
|
|
117 ;;; Bugs with `cperl-auto-newline' corrected.
|
|
|
118 ;;; `cperl-electric-lbrace' can work with `cperl-auto-newline' in situation
|
|
|
119 ;;; like $hash{.
|
|
|
120
|
|
|
121 ;;;; 1.7 XEmacs (arius@informatik.uni-erlangen.de):
|
|
|
122 ;;; - use `next-command-event', if `next-command-events' does not exist
|
|
|
123 ;;; - use `find-face' as def. of `is-face'
|
|
|
124 ;;; - corrected def. of `x-color-defined-p'
|
|
|
125 ;;; - added const defs for font-lock-comment-face,
|
|
|
126 ;;; font-lock-keyword-face and font-lock-function-name-face
|
|
|
127 ;;; - added def. of font-lock-variable-name-face
|
|
|
128 ;;; - added (require 'easymenu) inside an `eval-when-compile'
|
|
|
129 ;;; - replaced 4-argument `substitute-key-definition' with ordinary
|
|
|
130 ;;; `define-key's
|
|
|
131 ;;; - replaced `mark-active' in menu definition by `cperl-use-region-p'.
|
|
|
132 ;;; Todo (at least):
|
|
|
133 ;;; - use emacs-vers.el (http://www.cs.utah.edu/~eeide/emacs/emacs-vers.el.gz)
|
|
|
134 ;;; for portable code?
|
|
|
135 ;;; - should `cperl-mode' do a
|
|
|
136 ;;; (if (featurep 'easymenu) (easy-menu-add cperl-menu))
|
|
|
137 ;;; or should this be left to the user's `cperl-mode-hook'?
|
|
|
138
|
|
|
139 ;;; Some bugs introduced by the above fix corrected (IZ ;-).
|
|
|
140 ;;; Some bugs under XEmacs introduced by the correction corrected.
|
|
|
141
|
|
|
142 ;;; Some more can remain since there are two many different variants.
|
|
|
143 ;;; Please feedback!
|
|
|
144
|
|
|
145 ;;; We do not support fontification of arrays and hashes under
|
|
|
146 ;;; obsolete font-lock any more. Upgrade.
|
|
|
147
|
|
|
148 ;;;; after 1.8 Minor bug with parentheses.
|
|
|
149 ;;;; after 1.9 Improvements from Joe Marzot.
|
|
|
150 ;;;; after 1.10
|
|
|
151 ;;; Does not need easymenu to compile under XEmacs.
|
|
|
152 ;;; `vc-insert-headers' should work better.
|
|
|
153 ;;; Should work with 19.29 and 19.12.
|
|
|
154 ;;; Small improvements to fontification.
|
|
|
155 ;;; Expansion of keywords does not depend on C-? being backspace.
|
|
|
156
|
|
|
157 ;;; after 1.10+
|
|
|
158 ;;; 19.29 and 19.12 supported.
|
|
|
159 ;;; `cperl-font-lock-enhanced' deprecated. Use font-lock-extra.el.
|
|
|
160 ;;; Support for font-lock-extra.el.
|
|
|
161
|
|
|
162 ;;;; After 1.11:
|
|
|
163 ;;; Tools submenu.
|
|
|
164 ;;; Support for perl5-info.
|
|
|
165 ;;; `imenu-go-find-at-position' in Tools requires imenu-go.el (see hints above)
|
|
|
166 ;;; Imenu entries do not work with stock imenu.el. Patch sent to maintainers.
|
|
|
167 ;;; Fontifies `require a if b;', __DATA__.
|
|
|
168 ;;; Arglist for auto-fill-mode was incorrect.
|
|
|
169
|
|
|
170 ;;;; After 1.12:
|
|
|
171 ;;; `cperl-lineup-step' and `cperl-lineup' added: lineup constructions
|
|
|
172 ;;; vertically.
|
|
|
173 ;;; `cperl-do-auto-fill' updated for 19.29 style.
|
|
|
174 ;;; `cperl-info-on-command' now has a default.
|
|
|
175 ;;; Workaround for broken C-h on XEmacs.
|
|
|
176 ;;; VC strings escaped.
|
|
|
177 ;;; C-h f now may prompt for function name instead of going on,
|
|
|
178 ;;; controlled by `cperl-info-on-command-no-prompt'.
|
|
|
179
|
|
|
180 ;;;; After 1.13:
|
|
|
181 ;;; Msb buffer list includes perl files
|
|
|
182 ;;; Indent-for-comment uses indent-to
|
|
|
183 ;;; Can write tag files using etags.
|
|
|
184
|
|
|
185 ;;;; After 1.14:
|
|
|
186 ;;; Recognizes (tries to ;-) {...} which are not blocks during indentation.
|
|
|
187 ;;; `cperl-close-paren-offset' affects ?\] too (and ?\} if not block)
|
|
|
188 ;;; Bug with auto-filling comments started with "##" corrected.
|
|
|
189
|
|
|
190 ;;;; Very slow now: on DB::DB 0.91, 486/66:
|
|
|
191
|
|
|
192 ;;;Function Name Call Count Elapsed Time Average Time
|
|
|
193 ;;;======================================== ========== ============ ============
|
|
|
194 ;;;cperl-block-p 469 3.7799999999 0.0080597014
|
|
|
195 ;;;cperl-get-state 505 163.39000000 0.3235445544
|
|
|
196 ;;;cperl-comment-indent 12 0.0299999999 0.0024999999
|
|
|
197 ;;;cperl-backward-to-noncomment 939 4.4599999999 0.0047497337
|
|
|
198 ;;;cperl-calculate-indent 505 172.22000000 0.3410297029
|
|
|
199 ;;;cperl-indent-line 505 172.88000000 0.3423366336
|
|
|
200 ;;;cperl-use-region-p 40 0.0299999999 0.0007499999
|
|
|
201 ;;;cperl-indent-exp 1 177.97000000 177.97000000
|
|
|
202 ;;;cperl-to-comment-or-eol 1453 3.9800000000 0.0027391603
|
|
|
203 ;;;cperl-backward-to-start-of-continued-exp 9 0.0300000000 0.0033333333
|
|
|
204 ;;;cperl-indent-region 1 177.94000000 177.94000000
|
|
|
205
|
|
|
206 ;;;; After 1.15:
|
|
|
207 ;;; Takes into account white space after opening parentheses during indent.
|
|
|
208 ;;; May highlight pods and here-documents: see `cperl-pod-here-scan',
|
|
|
209 ;;; `cperl-pod-here-fontify', `cperl-pod-face'. Does not use this info
|
|
|
210 ;;; for indentation so far.
|
|
|
211 ;;; Fontification updated to 19.30 style.
|
|
|
212 ;;; The change 19.29->30 did not add all the required functionality,
|
|
|
213 ;;; but broke "font-lock-extra.el". Get "choose-color.el" from
|
|
|
214 ;;; ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
|
|
|
215
|
|
|
216 ;;;; After 1.16:
|
|
|
217 ;;; else # comment
|
|
|
218 ;;; recognized as a start of a block.
|
|
|
219 ;;; Two different font-lock-levels provided.
|
|
|
220 ;;; `cperl-pod-head-face' introduced. Used for highlighting.
|
|
|
221 ;;; `imenu' marks pods, +Packages moved to the head.
|
|
|
222
|
|
|
223 ;;;; After 1.17:
|
|
|
224 ;;; Scan for pods highlights here-docs too.
|
|
|
225 ;;; Note that the tag of here-doc may be rehighlighted later by lazy-lock.
|
|
|
226 ;;; Only one here-doc-tag per line is supported, and one in comment
|
|
|
227 ;;; or a string may break fontification.
|
|
|
228 ;;; POD headers were supposed to fill one line only.
|
|
|
229
|
|
|
230 ;;;; After 1.18:
|
|
|
231 ;;; `font-lock-keywords' were set in 19.30 style _always_. Current scheme
|
|
|
232 ;;; may break under XEmacs.
|
|
|
233 ;;; `cperl-calculate-indent' dis suppose that `parse-start' was defined.
|
|
|
234 ;;; `fontified' tag is added to fontified text as well as `lazy-lock' (for
|
|
|
235 ;;; compatibility with older lazy-lock.el) (older one overfontifies
|
|
|
236 ;;; something nevertheless :-().
|
|
|
237 ;;; Will not indent something inside pod and here-documents.
|
|
|
238 ;;; Fontifies the package name after import/no/bootstrap.
|
|
|
239 ;;; Added new entry to menu with meta-info about the mode.
|
|
|
240
|
|
|
241 ;;;; After 1.19:
|
|
|
242 ;;; Prefontification works much better with 19.29. Should be checked
|
|
|
243 ;;; with 19.30 as well.
|
|
|
244 ;;; Some misprints in docs corrected.
|
|
|
245 ;;; Now $a{-text} and -text => "blah" are fontified as strings too.
|
|
|
246 ;;; Now the pod search is much stricter, so it can help you to find
|
|
|
247 ;;; pod sections which are broken because of whitespace before =blah
|
|
|
248 ;;; - just observe the fontification.
|
|
|
249
|
|
|
250 ;;;; After 1.20
|
|
|
251 ;;; Anonymous subs are indented with respect to the level of
|
|
|
252 ;;; indentation of `sub' now.
|
|
|
253 ;;; {} is recognized as hash after `bless' and `return'.
|
|
|
254 ;;; Anonymous subs are split by `cperl-linefeed' as well.
|
|
|
255 ;;; Electric parens embrace a region if present.
|
|
|
256 ;;; To make `cperl-auto-newline' useful,
|
|
|
257 ;;; `cperl-auto-newline-after-colon' is introduced.
|
|
|
258 ;;; `cperl-electric-parens' is now t or nul. The old meaning is moved to
|
|
|
259 ;;; `cperl-electric-parens-string'.
|
|
|
260 ;;; `cperl-toggle-auto-newline' introduced, put on C-c C-a.
|
|
|
261 ;;; `cperl-toggle-abbrev' introduced, put on C-c C-k.
|
|
|
262 ;;; `cperl-toggle-electric' introduced, put on C-c C-e.
|
|
|
263 ;;; Beginning-of-defun-regexp was not anchored.
|
|
|
264
|
|
|
265 ;;;; After 1.21
|
|
|
266 ;;; Auto-newline grants `cperl-extra-newline-before-brace' if "{" is typed
|
|
|
267 ;;; after ")".
|
|
|
268 ;;; {} is recognized as expression after `tr' and friends.
|
|
|
269 ;;; Works with XEmacs again.
|
|
|
270
|
|
|
271 (defvar cperl-extra-newline-before-brace nil
|
|
|
272 "*Non-nil means that if, elsif, while, until, else, for, foreach
|
|
|
273 and do constructs look like:
|
|
|
274
|
|
|
275 if ()
|
|
|
276 {
|
|
|
277 }
|
|
|
278
|
|
|
279 instead of:
|
|
|
280
|
|
|
281 if () {
|
|
|
282 }
|
|
|
283 ")
|
|
|
284
|
|
|
285 (defvar cperl-indent-level 2
|
|
|
286 "*Indentation of CPerl statements with respect to containing block.")
|
|
|
287 (defvar cperl-lineup-step nil
|
|
|
288 "*`cperl-lineup' will always lineup at multiple of this number.
|
|
|
289 If `nil', the value of `cperl-indent-level' will be used.")
|
|
|
290 (defvar cperl-brace-imaginary-offset 0
|
|
|
291 "*Imagined indentation of a Perl open brace that actually follows a statement.
|
|
|
292 An open brace following other text is treated as if it were this far
|
|
|
293 to the right of the start of its line.")
|
|
|
294 (defvar cperl-brace-offset 0
|
|
|
295 "*Extra indentation for braces, compared with other text in same context.")
|
|
|
296 (defvar cperl-label-offset -2
|
|
|
297 "*Offset of CPerl label lines relative to usual indentation.")
|
|
|
298 (defvar cperl-min-label-indent 1
|
|
|
299 "*Minimal offset of CPerl label lines.")
|
|
|
300 (defvar cperl-continued-statement-offset 2
|
|
|
301 "*Extra indent for lines not starting new statements.")
|
|
|
302 (defvar cperl-continued-brace-offset 0
|
|
|
303 "*Extra indent for substatements that start with open-braces.
|
|
|
304 This is in addition to cperl-continued-statement-offset.")
|
|
|
305 (defvar cperl-close-paren-offset -1
|
|
|
306 "*Extra indent for substatements that start with close-parenthesis.")
|
|
|
307
|
|
|
308 (defvar cperl-auto-newline nil
|
|
|
309 "*Non-nil means automatically newline before and after braces,
|
|
|
310 and after colons and semicolons, inserted in CPerl code. The following
|
|
|
311 \\[cperl-electric-backspace] will remove the inserted whitespace.
|
|
|
312 Insertion after colons requires both this variable and
|
|
|
313 `cperl-auto-newline-after-colon' set.")
|
|
|
314
|
|
|
315 (defvar cperl-auto-newline-after-colon nil
|
|
|
316 "*Non-nil means automatically newline even after colons.
|
|
|
317 Subject to `cperl-auto-newline' setting.")
|
|
|
318
|
|
|
319 (defvar cperl-tab-always-indent t
|
|
|
320 "*Non-nil means TAB in CPerl mode should always reindent the current line,
|
|
|
321 regardless of where in the line point is when the TAB command is used.")
|
|
|
322
|
|
|
323 (defvar cperl-font-lock nil
|
|
|
324 "*Non-nil (and non-null) means CPerl buffers will use font-lock-mode.
|
|
|
325 Can be overwritten by `cperl-hairy' if nil.")
|
|
|
326
|
|
|
327 (defvar cperl-electric-lbrace-space nil
|
|
|
328 "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceeded by ` '.
|
|
|
329 Can be overwritten by `cperl-hairy' if nil.")
|
|
|
330
|
|
|
331 (defvar cperl-electric-parens-string "({[<"
|
|
|
332 "*String of parentheses that should be electric in CPerl.")
|
|
|
333
|
|
|
334 (defvar cperl-electric-parens nil
|
|
|
335 "*Non-nil (and non-null) means parentheses should be electric in CPerl.
|
|
|
336 Can be overwritten by `cperl-hairy' if nil.")
|
|
|
337
|
|
|
338 (defvar cperl-electric-parens-mark (and window-system
|
|
|
339 (or (and ; Emacs
|
|
|
340 (boundp 'transient-mark-mode)
|
|
|
341 transient-mark-mode)
|
|
|
342 (and ; XEmacs
|
|
|
343 (boundp 'zmacs-regions)
|
|
|
344 zmacs-regions)))
|
|
|
345 "*Not-nil means that electric parens look for active mark.
|
|
|
346 Default is yes if there is visual feedback on mark.")
|
|
|
347
|
|
|
348 (defvar cperl-electric-linefeed nil
|
|
|
349 "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy.
|
|
|
350 In any case these two mean plain and hairy linefeeds together.
|
|
|
351 Can be overwritten by `cperl-hairy' if nil.")
|
|
|
352
|
|
|
353 (defvar cperl-electric-keywords nil
|
|
|
354 "*Not-nil (and non-null) means keywords are electric in CPerl.
|
|
|
355 Can be overwritten by `cperl-hairy' if nil.")
|
|
|
356
|
|
|
357 (defvar cperl-hairy nil
|
|
|
358 "*Not-nil means all the bells and whistles are enabled in CPerl.")
|
|
|
359
|
|
|
360 (defvar cperl-comment-column 32
|
|
|
361 "*Column to put comments in CPerl (use \\[cperl-indent]' to lineup with code).")
|
|
|
362
|
|
|
363 (defvar cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;")
|
|
|
364 (RCS "$rcs = ' $Id\$ ' ;"))
|
|
|
365 "*What to use as `vc-header-alist' in CPerl.")
|
|
|
366
|
|
|
367 (defvar cperl-info-on-command-no-prompt nil
|
|
|
368 "*Not-nil (and non-null) means not to prompt on C-h f.
|
|
|
369 The opposite behaviour is always available if prefixed with C-c.
|
|
|
370 Can be overwritten by `cperl-hairy' if nil.")
|
|
|
371
|
|
|
372 (defvar cperl-pod-face 'font-lock-comment-face
|
|
|
373 "*The result of evaluation of this expression is used for pod highlighting.")
|
|
|
374
|
|
|
375 (defvar cperl-pod-head-face 'font-lock-variable-name-face
|
|
|
376 "*The result of evaluation of this expression is used for pod highlighting.
|
|
|
377 Font for POD headers.")
|
|
|
378
|
|
|
379 (defvar cperl-here-face 'font-lock-string-face
|
|
|
380 "*The result of evaluation of this expression is used for here-docs highlighting.")
|
|
|
381
|
|
|
382 (defvar cperl-pod-here-fontify '(featurep 'font-lock)
|
|
|
383 "*Not-nil after evaluation means to highlight pod and here-docs sections.")
|
|
|
384
|
|
|
385 (defvar cperl-pod-here-scan t
|
|
|
386 "*Not-nil means look for pod and here-docs sections during startup.
|
|
|
387 You can always make lookup from menu or using \\[cperl-find-pods-heres].")
|
|
|
388
|
|
|
389
|
|
|
390
|
|
|
391 ;;; Short extra-docs.
|
|
|
392
|
|
|
393 (defvar cperl-tips 'please-ignore-this-line
|
|
|
394 "Get newest version of this package from
|
|
|
395 ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
|
|
|
396 and/or
|
|
|
397 ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
|
|
|
398
|
|
|
399 Get support packages font-lock-extra.el, imenu-go.el from the same place.
|
|
|
400 \(Look for other files there too... ;-) Get a patch for imenu.el in 19.29.
|
|
|
401 Note that for 19.30 you should use choose-color.el *instead* of
|
|
|
402 font-lock-extra.el (and you will not get smart highlighting in C :-().
|
|
|
403
|
|
|
404 Note that to enable Compile choices in the menu you need to install
|
|
|
405 mode-compile.el.
|
|
|
406
|
|
|
407 Get perl5-info from
|
|
|
408 http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz
|
|
|
409 \(may be quite obsolete, but still useful).
|
|
|
410
|
|
|
411 If you use imenu-go, run imenu on perl5-info buffer (you can do it from
|
|
|
412 CPerl menu).
|
|
|
413
|
|
|
414 Before reporting (non-)problems look in the problem section on what I
|
|
|
415 know about them.")
|
|
|
416
|
|
|
417 (defvar cperl-problems 'please-ignore-this-line
|
|
|
418 "Emacs has a _very_ restricted syntax parsing engine.
|
|
|
419
|
|
|
420 It may be corrected on the level of C code, please look in the
|
|
|
421 `non-problems' section if you want to volunteer.
|
|
|
422
|
|
|
423 CPerl mode tries to corrects some Emacs misunderstandings, however,
|
|
|
424 for effeciency reasons the degree of correction is different for
|
|
|
425 different operations. The partially corrected problems are: POD
|
|
|
426 sections, here-documents, regexps. The operations are: highlighting,
|
|
|
427 indentation, electric keywords, electric braces.
|
|
|
428
|
|
|
429 This may be confusing, since the regexp s#//#/#\; may be highlighted
|
|
|
430 as a comment, but it will recognized as a regexp by the indentation
|
|
|
431 code. Or the opposite case, when a pod section is highlighted, but
|
|
|
432 breaks the indentation of the following code.
|
|
|
433
|
|
|
434 The main trick (to make $ a \"backslash\") makes constructions like
|
|
|
435 ${aaa} look like unbalanced braces. The only trick I can think out is
|
|
|
436 to insert it as $ {aaa} (legal in perl5, not in perl4).
|
|
|
437
|
|
|
438 Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
|
|
|
439 as /($|\\s)/. Note that such a transpositinon is not always possible
|
|
|
440 :-(. " )
|
|
|
441
|
|
|
442 (defvar cperl-non-problems 'please-ignore-this-line
|
|
|
443 "As you know from `problems' section, Perl syntax too hard for CPerl.
|
|
|
444
|
|
|
445 Most the time, if you write your own code, you may find an equivalent
|
|
|
446 \(and almost as readable) expression.
|
|
|
447
|
|
|
448 Try to help it: add comments with embedded quotes to fix CPerl
|
|
|
449 misunderstandings about the end of quotation:
|
|
|
450
|
|
|
451 $a='500$'; # ';
|
|
|
452
|
|
|
453 You won't need it too often. The reason: $ \"quotes\" the following
|
|
|
454 character (this saves a life a lot of times in CPerl), thus due to
|
|
|
455 Emacs parsing rules it does not consider tick after the dollar as a
|
|
|
456 closing one, but as a usual character.
|
|
|
457
|
|
|
458 Now the indentation code is pretty wise. The only drawback is that it
|
|
|
459 relies on Emacs parsing to find matching parentheses. And Emacs
|
|
|
460 *cannot* match parentheses in Perl 100% correctly. So
|
|
|
461 1 if s#//#/#;
|
|
|
462 will not break indentation, but
|
|
|
463 1 if ( s#//#/# );
|
|
|
464 will.
|
|
|
465
|
|
|
466 If you still get wrong indentation in situation that you think the
|
|
|
467 code should be able to parse, try:
|
|
|
468
|
|
|
469 a) Check what Emacs thinks about balance of your parentheses.
|
|
|
470 b) Supply the code to me (IZ).
|
|
|
471
|
|
|
472 Pods are treated _very_ rudimentally. Here-documents are not treated
|
|
|
473 at all (except highlighting and inhibiting indentation). (This may
|
|
|
474 change some time. RMS approved making syntax lookup recognize text
|
|
|
475 attributes, but volonteers are needed to change Emacs C code.)
|
|
|
476
|
|
|
477 To speed up coloring the following compromises exist:
|
|
|
478 a) sub in $mypackage::sub may be highlighted.
|
|
|
479 b) -z in [a-z] may be highlighted.
|
|
|
480 c) if your regexp contains a keyword (like \"s\"), it may be highlighted.
|
|
|
481 ")
|
|
|
482
|
|
|
483
|
|
|
484
|
|
|
485 ;;; Portability stuff:
|
|
|
486
|
|
|
487 (defsubst cperl-xemacs-p ()
|
|
|
488 (string-match "XEmacs\\|Lucid" emacs-version))
|
|
|
489
|
|
|
490 (defvar del-back-ch (car (append (where-is-internal 'delete-backward-char)
|
|
|
491 (where-is-internal 'backward-delete-char-untabify)))
|
|
|
492 "Character generated by key bound to delete-backward-char.")
|
|
|
493
|
|
|
494 (and (vectorp del-back-ch) (= (length del-back-ch) 1)
|
|
|
495 (setq del-back-ch (aref del-back-ch 0)))
|
|
|
496
|
|
|
497 (if (cperl-xemacs-p)
|
|
|
498 (progn
|
|
|
499 ;; "Active regions" are on: use region only if active
|
|
|
500 ;; "Active regions" are off: use region unconditionally
|
|
|
501 (defun cperl-use-region-p ()
|
|
|
502 (if zmacs-regions (mark) t))
|
|
|
503 (defun cperl-mark-active () (mark)))
|
|
|
504 (defun cperl-use-region-p ()
|
|
|
505 (if transient-mark-mode mark-active t))
|
|
|
506 (defun cperl-mark-active () mark-active))
|
|
|
507
|
|
|
508 (defsubst cperl-enable-font-lock ()
|
|
|
509 (or (cperl-xemacs-p) window-system))
|
|
|
510
|
|
|
511 (if (boundp 'unread-command-events)
|
|
|
512 (if (cperl-xemacs-p)
|
|
|
513 (defun cperl-putback-char (c) ; XEmacs >= 19.12
|
|
|
514 (setq unread-command-events (list (character-to-event c))))
|
|
|
515 (defun cperl-putback-char (c) ; Emacs 19
|
|
|
516 (setq unread-command-events (list c))))
|
|
|
517 (defun cperl-putback-char (c) ; XEmacs <= 19.11
|
|
|
518 (setq unread-command-event (character-to-event c))))
|
|
|
519
|
|
|
520 (or (fboundp 'uncomment-region)
|
|
|
521 (defun uncomment-region (beg end)
|
|
|
522 (interactive "r")
|
|
|
523 (comment-region beg end -1)))
|
|
|
524
|
|
|
525 (defvar cperl-do-not-fontify
|
|
|
526 (if (string< emacs-version "19.30")
|
|
|
527 'fontified
|
|
|
528 'lazy-lock)
|
|
|
529 "Text property which inhibits refontification.")
|
|
|
530
|
|
|
531
|
|
|
532 ;;; Probably it is too late to set these guys already, but it can help later:
|
|
|
533
|
|
|
534 (setq auto-mode-alist
|
|
|
535 (append '(("\\.[pP][Llm]$" . perl-mode)) auto-mode-alist ))
|
|
|
536 (and (boundp 'interpreter-mode-alist)
|
|
|
537 (setq interpreter-mode-alist (append interpreter-mode-alist
|
|
|
538 '(("miniperl" . perl-mode)))))
|
|
|
539 (if (fboundp 'eval-when-compile)
|
|
|
540 (eval-when-compile
|
|
|
541 (condition-case nil
|
|
|
542 (require 'imenu)
|
|
|
543 (error nil))
|
|
|
544 (condition-case nil
|
|
|
545 (require 'easymenu)
|
|
|
546 (error nil))
|
|
|
547 ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs,
|
|
|
548 ;; macros instead of defsubsts don't work on Emacs, so we do the
|
|
|
549 ;; expansion manually. Any other suggestions?
|
|
|
550 (if (or (string-match "XEmacs\\|Lucid" emacs-version)
|
|
|
551 window-system)
|
|
|
552 (require 'font-lock))
|
|
|
553 (require 'cl)
|
|
|
554 ))
|
|
|
555
|
|
|
556 (defvar cperl-mode-abbrev-table nil
|
|
|
557 "Abbrev table in use in Cperl-mode buffers.")
|
|
|
558
|
|
|
559 (add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))
|
|
|
560
|
|
|
561 (defvar cperl-mode-map () "Keymap used in CPerl mode.")
|
|
|
562
|
|
|
563 (if cperl-mode-map nil
|
|
|
564 (setq cperl-mode-map (make-sparse-keymap))
|
|
|
565 (define-key cperl-mode-map "{" 'cperl-electric-lbrace)
|
|
|
566 (define-key cperl-mode-map "[" 'cperl-electric-paren)
|
|
|
567 (define-key cperl-mode-map "(" 'cperl-electric-paren)
|
|
|
568 (define-key cperl-mode-map "<" 'cperl-electric-paren)
|
|
|
569 (define-key cperl-mode-map "}" 'cperl-electric-brace)
|
|
|
570 (define-key cperl-mode-map ";" 'cperl-electric-semi)
|
|
|
571 (define-key cperl-mode-map ":" 'cperl-electric-terminator)
|
|
|
572 (define-key cperl-mode-map "\C-j" 'newline-and-indent)
|
|
|
573 (define-key cperl-mode-map "\C-c\C-j" 'cperl-linefeed)
|
|
|
574 (define-key cperl-mode-map "\C-c\C-a" 'cperl-toggle-auto-newline)
|
|
|
575 (define-key cperl-mode-map "\C-c\C-k" 'cperl-toggle-abbrev)
|
|
|
576 (define-key cperl-mode-map "\C-c\C-e" 'cperl-toggle-electric)
|
|
|
577 (define-key cperl-mode-map "\e\C-q" 'cperl-indent-exp) ; Usually not bound
|
|
|
578 ;;(define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
|
|
|
579 ;;(define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
|
|
|
580 (define-key cperl-mode-map "\177" 'cperl-electric-backspace)
|
|
|
581 (define-key cperl-mode-map "\t" 'cperl-indent-command)
|
|
|
582 (if (cperl-xemacs-p)
|
|
|
583 ;; don't clobber the backspace binding:
|
|
|
584 (define-key cperl-mode-map [(control h) f] 'cperl-info-on-command)
|
|
|
585 (define-key cperl-mode-map "\C-hf" 'cperl-info-on-command))
|
|
|
586 (if (cperl-xemacs-p)
|
|
|
587 ;; don't clobber the backspace binding:
|
|
|
588 (define-key cperl-mode-map [(control c) (control h) f]
|
|
|
589 'cperl-info-on-current-command)
|
|
|
590 (define-key cperl-mode-map "\C-c\C-hf" 'cperl-info-on-current-command))
|
|
|
591 (if (and (cperl-xemacs-p)
|
|
|
592 (<= emacs-minor-version 11) (<= emacs-major-version 19))
|
|
|
593 (progn
|
|
|
594 ;; substitute-key-definition is usefulness-deenhanced...
|
|
|
595 (define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
|
|
|
596 (define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
|
|
|
597 (define-key cperl-mode-map "\e\C-\\" 'cperl-indent-region))
|
|
|
598 (substitute-key-definition
|
|
|
599 'indent-sexp 'cperl-indent-exp
|
|
|
600 cperl-mode-map global-map)
|
|
|
601 (substitute-key-definition
|
|
|
602 'fill-paragraph 'cperl-fill-paragraph
|
|
|
603 cperl-mode-map global-map)
|
|
|
604 (substitute-key-definition
|
|
|
605 'indent-region 'cperl-indent-region
|
|
|
606 cperl-mode-map global-map)
|
|
|
607 (substitute-key-definition
|
|
|
608 'indent-for-comment 'cperl-indent-for-comment
|
|
|
609 cperl-mode-map global-map)))
|
|
|
610
|
|
|
611 (condition-case nil
|
|
|
612 (progn
|
|
|
613 (require 'easymenu)
|
|
|
614 (easy-menu-define cperl-menu cperl-mode-map "Menu for CPerl mode"
|
|
|
615 '("Perl"
|
|
|
616 ["Beginning of function" beginning-of-defun t]
|
|
|
617 ["End of function" end-of-defun t]
|
|
|
618 ["Mark function" mark-defun t]
|
|
|
619 ["Indent expression" cperl-indent-exp t]
|
|
|
620 ["Fill paragraph/comment" cperl-fill-paragraph t]
|
|
|
621 ["Line up a construction" cperl-lineup (cperl-use-region-p)]
|
|
|
622 "----"
|
|
|
623 ["Indent region" cperl-indent-region (cperl-use-region-p)]
|
|
|
624 ["Comment region" comment-region (cperl-use-region-p)]
|
|
|
625 ["Uncomment region" uncomment-region (cperl-use-region-p)]
|
|
|
626 "----"
|
|
|
627 ["Run" mode-compile (fboundp 'mode-compile)]
|
|
|
628 ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
|
|
|
629 (get-buffer "*compilation*"))]
|
|
|
630 ["Next error" next-error (get-buffer "*compilation*")]
|
|
|
631 ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
|
|
|
632 "----"
|
|
|
633 ["Debugger" perldb t]
|
|
|
634 "----"
|
|
|
635 ("Tools"
|
|
|
636 ["Imenu" imenu (fboundp 'imenu)]
|
|
|
637 ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]
|
|
|
638 ("Tags"
|
|
|
639 ["Create tags for current file" cperl-etags t]
|
|
|
640 ["Add tags for current file" (cperl-etags t) t]
|
|
|
641 ["Create tags for Perl files in directory" (cperl-etags nil t) t]
|
|
|
642 ["Add tags for Perl files in directory" (cperl-etags t t) t]
|
|
|
643 ["Create tags for Perl files in (sub)directories"
|
|
|
644 (cperl-etags nil 'recursive) t]
|
|
|
645 ["Add tags for Perl files in (sub)directories"
|
|
|
646 (cperl-etags t 'recursive) t])
|
|
|
647 ["Recalculate PODs" cperl-find-pods-heres t]
|
|
|
648 ["Define word at point" imenu-go-find-at-position
|
|
|
649 (fboundp 'imenu-go-find-at-position)]
|
|
|
650 ["Help on function" cperl-info-on-command t]
|
|
|
651 ["Help on function at point" cperl-info-on-current-command t])
|
|
|
652 ("Toggle..."
|
|
|
653 ["Auto newline" cperl-toggle-auto-newline t]
|
|
|
654 ["Electric parens" cperl-toggle-electric t]
|
|
|
655 ["Electric keywords" cperl-toggle-abbrev t]
|
|
|
656 )
|
|
|
657 ("Indent styles..."
|
|
|
658 ["GNU" (cperl-set-style "GNU") t]
|
|
|
659 ["C++" (cperl-set-style "C++") t]
|
|
|
660 ["FSF" (cperl-set-style "FSF") t]
|
|
|
661 ["BSD" (cperl-set-style "BSD") t]
|
|
|
662 ["Whitesmith" (cperl-set-style "Whitesmith") t])
|
|
|
663 ("Micro-docs"
|
|
|
664 ["Tips" (describe-variable 'cperl-tips) t]
|
|
|
665 ["Problems" (describe-variable 'cperl-problems) t]
|
|
|
666 ["Non-problems" (describe-variable 'cperl-non-problems) t]))))
|
|
|
667 (error nil))
|
|
|
668
|
|
|
669 (autoload 'c-macro-expand "cmacexp"
|
|
|
670 "Display the result of expanding all C macros occurring in the region.
|
|
|
671 The expansion is entirely correct because it uses the C preprocessor."
|
|
|
672 t)
|
|
|
673
|
|
|
674 (defvar cperl-mode-syntax-table nil
|
|
|
675 "Syntax table in use in Cperl-mode buffers.")
|
|
|
676
|
|
|
677 (if cperl-mode-syntax-table
|
|
|
678 ()
|
|
|
679 (setq cperl-mode-syntax-table (make-syntax-table))
|
|
|
680 (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table)
|
|
|
681 (modify-syntax-entry ?/ "." cperl-mode-syntax-table)
|
|
|
682 (modify-syntax-entry ?* "." cperl-mode-syntax-table)
|
|
|
683 (modify-syntax-entry ?+ "." cperl-mode-syntax-table)
|
|
|
684 (modify-syntax-entry ?- "." cperl-mode-syntax-table)
|
|
|
685 (modify-syntax-entry ?= "." cperl-mode-syntax-table)
|
|
|
686 (modify-syntax-entry ?% "." cperl-mode-syntax-table)
|
|
|
687 (modify-syntax-entry ?< "." cperl-mode-syntax-table)
|
|
|
688 (modify-syntax-entry ?> "." cperl-mode-syntax-table)
|
|
|
689 (modify-syntax-entry ?& "." cperl-mode-syntax-table)
|
|
|
690 (modify-syntax-entry ?$ "\\" cperl-mode-syntax-table)
|
|
|
691 (modify-syntax-entry ?\n ">" cperl-mode-syntax-table)
|
|
|
692 (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
|
|
|
693 (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
|
|
|
694 (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
|
|
|
695 (modify-syntax-entry ?_ "w" cperl-mode-syntax-table)
|
|
|
696 (modify-syntax-entry ?| "." cperl-mode-syntax-table))
|
|
|
697
|
|
|
698
|
|
|
699
|
|
|
700 ;; Make customization possible "in reverse"
|
|
|
701 ;;(defun cperl-set (symbol to)
|
|
|
702 ;; (or (eq (symbol-value symbol) 'null) (set symbol to)))
|
|
|
703 (defsubst cperl-val (symbol &optional default hairy)
|
|
|
704 (cond
|
|
|
705 ((eq (symbol-value symbol) 'null) default)
|
|
|
706 (cperl-hairy (or hairy t))
|
|
|
707 (t (symbol-value symbol))))
|
|
|
708
|
|
|
709 ;; provide an alias for working with emacs 19. the perl-mode that comes
|
|
|
710 ;; with it is really bad, and this lets us seamlessly replace it.
|
|
|
711 (fset 'perl-mode 'cperl-mode)
|
|
|
712 (defun cperl-mode ()
|
|
|
713 "Major mode for editing Perl code.
|
|
|
714 Expression and list commands understand all C brackets.
|
|
|
715 Tab indents for Perl code.
|
|
|
716 Paragraphs are separated by blank lines only.
|
|
|
717 Delete converts tabs to spaces as it moves back.
|
|
|
718
|
|
|
719 Various characters in Perl almost always come in pairs: {}, (), [],
|
|
|
720 sometimes <>. When the user types the first, she gets the second as
|
|
|
721 well, with optional special formatting done on {}. (Disabled by
|
|
|
722 default.) You can always quote (with \\[quoted-insert]) the left
|
|
|
723 \"paren\" to avoid the expansion. The processing of < is special,
|
|
|
724 since most the time you mean \"less\". Cperl mode tries to guess
|
|
|
725 whether you want to type pair <>, and inserts is if it
|
|
|
726 appropriate. You can set `cperl-electric-parens-string' to the string that
|
|
|
727 contains the parenths from the above list you want to be electrical.
|
|
|
728 Electricity of parenths is controlled by `cperl-electric-parens'.
|
|
|
729 You may also set `cperl-electric-parens-mark' to have electric parens
|
|
|
730 look for active mark and \"embrace\" a region if possible.'
|
|
|
731
|
|
|
732 CPerl mode provides expansion of the Perl control constructs:
|
|
|
733 if, else, elsif, unless, while, until, for, and foreach.
|
|
|
734 =========(Disabled by default, see `cperl-electric-keywords'.)
|
|
|
735 The user types the keyword immediately followed by a space, which causes
|
|
|
736 the construct to be expanded, and the user is positioned where she is most
|
|
|
737 likely to want to be.
|
|
|
738 eg. when the user types a space following \"if\" the following appears in
|
|
|
739 the buffer:
|
|
|
740 if () { or if ()
|
|
|
741 } {
|
|
|
742 }
|
|
|
743 and the cursor is between the parentheses. The user can then type some
|
|
|
744 boolean expression within the parens. Having done that, typing
|
|
|
745 \\[cperl-linefeed] places you, appropriately indented on a new line
|
|
|
746 between the braces. If CPerl decides that you want to insert
|
|
|
747 \"English\" style construct like
|
|
|
748 bite if angry;
|
|
|
749 it will not do any expansion. See also help on variable
|
|
|
750 `cperl-extra-newline-before-brace'.
|
|
|
751
|
|
|
752 \\[cperl-linefeed] is a convinience replacement for typing carriage
|
|
|
753 return. It places you in the next line with proper indentation, or if
|
|
|
754 you type it inside the inline block of control construct, like
|
|
|
755 foreach (@lines) {print; print}
|
|
|
756 and you are on a boundary of a statement inside braces, it will
|
|
|
757 transform the construct into a multiline and will place you into an
|
|
|
758 apporpriately indented blank line. If you need a usual
|
|
|
759 `newline-and-indent' behaviour, it is on \\[newline-and-indent],
|
|
|
760 see documentation on `cperl-electric-linefeed'.
|
|
|
761
|
|
|
762 \\{cperl-mode-map}
|
|
|
763
|
|
|
764 Setting the variable `cperl-font-lock' to t switches on
|
|
|
765 font-lock-mode, `cperl-electric-lbrace-space' to t switches on
|
|
|
766 electric space between $ and {, `cperl-electric-parens-string' is the
|
|
|
767 string that contains parentheses that should be electric in CPerl (see
|
|
|
768 also `cperl-electric-parens-mark' and `cperl-electric-parens'),
|
|
|
769 setting `cperl-electric-keywords' enables electric expansion of
|
|
|
770 control structures in CPerl. `cperl-electric-linefeed' governs which
|
|
|
771 one of two linefeed behavior is preferable. You can enable all these
|
|
|
772 options simultaneously (recommended mode of use) by setting
|
|
|
773 `cperl-hairy' to t. In this case you can switch separate options off
|
|
|
774 by setting them to `null'. Note that one may undo the extra whitespace
|
|
|
775 inserted by semis and braces in `auto-newline'-mode by consequent
|
|
|
776 \\[cperl-electric-backspace].
|
|
|
777
|
|
|
778 If your site has perl5 documentation in info format, you can use commands
|
|
|
779 \\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it.
|
|
|
780 These keys run commands `cperl-info-on-current-command' and
|
|
|
781 `cperl-info-on-command', which one is which is controlled by variable
|
|
|
782 `cperl-info-on-command-no-prompt' (in turn affected by `cperl-hairy').
|
|
|
783
|
|
|
784 Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
|
|
|
785 `cperl-pod-face', `cperl-pod-head-face' control processing of pod and
|
|
|
786 here-docs sections. In a future version results of scan may be used
|
|
|
787 for indentation too, currently they are used for highlighting only.
|
|
|
788
|
|
|
789 Variables controlling indentation style:
|
|
|
790 `cperl-tab-always-indent'
|
|
|
791 Non-nil means TAB in CPerl mode should always reindent the current line,
|
|
|
792 regardless of where in the line point is when the TAB command is used.
|
|
|
793 `cperl-auto-newline'
|
|
|
794 Non-nil means automatically newline before and after braces,
|
|
|
795 and after colons and semicolons, inserted in Perl code. The following
|
|
|
796 \\[cperl-electric-backspace] will remove the inserted whitespace.
|
|
|
797 Insertion after colons requires both this variable and
|
|
|
798 `cperl-auto-newline-after-colon' set.
|
|
|
799 `cperl-auto-newline-after-colon'
|
|
|
800 Non-nil means automatically newline even after colons.
|
|
|
801 Subject to `cperl-auto-newline' setting.
|
|
|
802 `cperl-indent-level'
|
|
|
803 Indentation of Perl statements within surrounding block.
|
|
|
804 The surrounding block's indentation is the indentation
|
|
|
805 of the line on which the open-brace appears.
|
|
|
806 `cperl-continued-statement-offset'
|
|
|
807 Extra indentation given to a substatement, such as the
|
|
|
808 then-clause of an if, or body of a while, or just a statement continuation.
|
|
|
809 `cperl-continued-brace-offset'
|
|
|
810 Extra indentation given to a brace that starts a substatement.
|
|
|
811 This is in addition to `cperl-continued-statement-offset'.
|
|
|
812 `cperl-brace-offset'
|
|
|
813 Extra indentation for line if it starts with an open brace.
|
|
|
814 `cperl-brace-imaginary-offset'
|
|
|
815 An open brace following other text is treated as if it the line started
|
|
|
816 this far to the right of the actual line indentation.
|
|
|
817 `cperl-label-offset'
|
|
|
818 Extra indentation for line that is a label.
|
|
|
819 `cperl-min-label-indent'
|
|
|
820 Minimal indentation for line that is a label.
|
|
|
821
|
|
|
822 Settings for K&R and BSD indentation styles are
|
|
|
823 `cperl-indent-level' 5 8
|
|
|
824 `cperl-continued-statement-offset' 5 8
|
|
|
825 `cperl-brace-offset' -5 -8
|
|
|
826 `cperl-label-offset' -5 -8
|
|
|
827
|
|
|
828 If `cperl-indent-level' is 0, the statement after opening brace in column 0 is indented on `cperl-brace-offset'+`cperl-continued-statement-offset'.
|
|
|
829
|
|
|
830 Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook'
|
|
|
831 with no args."
|
|
|
832 (interactive)
|
|
|
833 (kill-all-local-variables)
|
|
|
834 ;;(if cperl-hairy
|
|
|
835 ;; (progn
|
|
|
836 ;; (cperl-set 'cperl-font-lock cperl-hairy)
|
|
|
837 ;; (cperl-set 'cperl-electric-lbrace-space cperl-hairy)
|
|
|
838 ;; (cperl-set 'cperl-electric-parens "{[(<")
|
|
|
839 ;; (cperl-set 'cperl-electric-keywords cperl-hairy)
|
|
|
840 ;; (cperl-set 'cperl-electric-linefeed cperl-hairy)))
|
|
|
841 (use-local-map cperl-mode-map)
|
|
|
842 (if (cperl-val 'cperl-electric-linefeed)
|
|
|
843 (progn
|
|
|
844 (local-set-key "\C-J" 'cperl-linefeed)
|
|
|
845 (local-set-key "\C-C\C-J" 'newline-and-indent)))
|
|
|
846 (if (cperl-val 'cperl-info-on-command-no-prompt)
|
|
|
847 (progn
|
|
|
848 (if (cperl-xemacs-p)
|
|
|
849 ;; don't clobber the backspace binding:
|
|
|
850 (local-set-key [(control h) f] 'cperl-info-on-current-command)
|
|
|
851 (local-set-key "\C-hf" 'cperl-info-on-current-command))
|
|
|
852 (if (cperl-xemacs-p)
|
|
|
853 ;; don't clobber the backspace binding:
|
|
|
854 (local-set-key [(control c) (control h) f]
|
|
|
855 'cperl-info-on-command)
|
|
|
856 (local-set-key "\C-c\C-hf" 'cperl-info-on-command))))
|
|
|
857 (setq major-mode 'perl-mode)
|
|
|
858 (setq mode-name "CPerl")
|
|
|
859 (if (not cperl-mode-abbrev-table)
|
|
|
860 (let ((prev-a-c abbrevs-changed))
|
|
|
861 (define-abbrev-table 'cperl-mode-abbrev-table '(
|
|
|
862 ("if" "if" cperl-electric-keyword 0)
|
|
|
863 ("elsif" "elsif" cperl-electric-keyword 0)
|
|
|
864 ("while" "while" cperl-electric-keyword 0)
|
|
|
865 ("until" "until" cperl-electric-keyword 0)
|
|
|
866 ("unless" "unless" cperl-electric-keyword 0)
|
|
|
867 ("else" "else" cperl-electric-else 0)
|
|
|
868 ("for" "for" cperl-electric-keyword 0)
|
|
|
869 ("foreach" "foreach" cperl-electric-keyword 0)
|
|
|
870 ("do" "do" cperl-electric-keyword 0)))
|
|
|
871 (setq abbrevs-changed prev-a-c)))
|
|
|
872 (setq local-abbrev-table cperl-mode-abbrev-table)
|
|
|
873 (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0))
|
|
|
874 (set-syntax-table cperl-mode-syntax-table)
|
|
|
875 (make-local-variable 'paragraph-start)
|
|
|
876 (setq paragraph-start (concat "^$\\|" page-delimiter))
|
|
|
877 (make-local-variable 'paragraph-separate)
|
|
|
878 (setq paragraph-separate paragraph-start)
|
|
|
879 (make-local-variable 'paragraph-ignore-fill-prefix)
|
|
|
880 (setq paragraph-ignore-fill-prefix t)
|
|
|
881 (make-local-variable 'indent-line-function)
|
|
|
882 (setq indent-line-function 'cperl-indent-line)
|
|
|
883 (make-local-variable 'require-final-newline)
|
|
|
884 (setq require-final-newline t)
|
|
|
885 (make-local-variable 'comment-start)
|
|
|
886 (setq comment-start "# ")
|
|
|
887 (make-local-variable 'comment-end)
|
|
|
888 (setq comment-end "")
|
|
|
889 (make-local-variable 'comment-column)
|
|
|
890 (setq comment-column cperl-comment-column)
|
|
|
891 (make-local-variable 'comment-start-skip)
|
|
|
892 (setq comment-start-skip "#+ *")
|
|
|
893 (make-local-variable 'defun-prompt-regexp)
|
|
|
894 (setq defun-prompt-regexp "^[ \t]*sub\\s +\\([^ \t\n{;]+\\)\\s *")
|
|
|
895 (make-local-variable 'comment-indent-function)
|
|
|
896 (setq comment-indent-function 'cperl-comment-indent)
|
|
|
897 (make-local-variable 'parse-sexp-ignore-comments)
|
|
|
898 (setq parse-sexp-ignore-comments t)
|
|
|
899 (make-local-variable 'indent-region-function)
|
|
|
900 (setq indent-region-function 'cperl-indent-region)
|
|
|
901 ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off!
|
|
|
902 (make-local-variable 'imenu-create-index-function)
|
|
|
903 (setq imenu-create-index-function
|
|
|
904 (function imenu-example--create-perl-index))
|
|
|
905 (make-local-variable 'imenu-sort-function)
|
|
|
906 (setq imenu-sort-function nil)
|
|
|
907 (make-local-variable 'vc-header-alist)
|
|
|
908 (setq vc-header-alist cperl-vc-header-alist)
|
|
|
909 (make-local-variable 'font-lock-defaults)
|
|
|
910 (setq font-lock-defaults
|
|
|
911 (if (string< emacs-version "19.30")
|
|
|
912 '(perl-font-lock-keywords-2)
|
|
|
913 '((perl-font-lock-keywords
|
|
|
914 perl-font-lock-keywords-1
|
|
|
915 perl-font-lock-keywords-2))))
|
|
|
916 (or (fboundp 'cperl-old-auto-fill-mode)
|
|
|
917 (progn
|
|
|
918 (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
|
|
|
919 (defun auto-fill-mode (&optional arg)
|
|
|
920 (interactive "P")
|
|
|
921 (cperl-old-auto-fill-mode arg)
|
|
|
922 (and auto-fill-function (eq major-mode 'perl-mode)
|
|
|
923 (setq auto-fill-function 'cperl-do-auto-fill)))))
|
|
|
924 (if (cperl-enable-font-lock)
|
|
|
925 (if (cperl-val 'cperl-font-lock)
|
|
|
926 (progn (or cperl-faces-init (cperl-init-faces))
|
|
|
927 (font-lock-mode 1))))
|
|
|
928 (and (boundp 'msb-menu-cond)
|
|
|
929 (not cperl-msb-fixed)
|
|
|
930 (cperl-msb-fix))
|
|
|
931 (run-hooks 'cperl-mode-hook)
|
|
|
932 ;; After hooks since fontification will break this
|
|
|
933 (if cperl-pod-here-scan (cperl-find-pods-heres)))
|
|
|
934
|
|
|
935 ;; Fix for msb.el
|
|
|
936 (defvar cperl-msb-fixed nil)
|
|
|
937
|
|
|
938 (defun cperl-msb-fix ()
|
|
|
939 ;; Adds perl files to msb menu, supposes that msb is already loaded
|
|
|
940 (setq cperl-msb-fixed t)
|
|
|
941 (let* ((l (length msb-menu-cond))
|
|
|
942 (last (nth (1- l) msb-menu-cond))
|
|
|
943 (precdr (nthcdr (- l 2) msb-menu-cond)) ; cdr of this is last
|
|
|
944 (handle (1- (nth 1 last))))
|
|
|
945 (setcdr precdr (list
|
|
|
946 (list
|
|
|
947 '(eq major-mode 'perl-mode)
|
|
|
948 handle
|
|
|
949 "Perl Files (%d)")
|
|
|
950 last))))
|
|
|
951
|
|
|
952 ;; This is used by indent-for-comment
|
|
|
953 ;; to decide how much to indent a comment in CPerl code
|
|
|
954 ;; based on its context. Do fallback if comment is found wrong.
|
|
|
955
|
|
|
956 (defvar cperl-wrong-comment)
|
|
|
957
|
|
|
958 (defun cperl-comment-indent ()
|
|
|
959 (let ((p (point)) (c (current-column)) was)
|
|
|
960 (if (looking-at "^#") 0 ; Existing comment at bol stays there.
|
|
|
961 ;; Wrong comment found
|
|
|
962 (save-excursion
|
|
|
963 (setq was (cperl-to-comment-or-eol))
|
|
|
964 (if (= (point) p)
|
|
|
965 (progn
|
|
|
966 (skip-chars-backward " \t")
|
|
|
967 (max (1+ (current-column)) ; Else indent at comment column
|
|
|
968 comment-column))
|
|
|
969 (if was nil
|
|
|
970 (insert comment-start)
|
|
|
971 (backward-char (length comment-start)))
|
|
|
972 (setq cperl-wrong-comment t)
|
|
|
973 (indent-to comment-column 1) ; Indent minimum 1
|
|
|
974 c))))) ; except leave at least one space.
|
|
|
975
|
|
|
976 ;;;(defun cperl-comment-indent-fallback ()
|
|
|
977 ;;; "Is called if the standard comment-search procedure fails.
|
|
|
978 ;;;Point is at start of real comment."
|
|
|
979 ;;; (let ((c (current-column)) target cnt prevc)
|
|
|
980 ;;; (if (= c comment-column) nil
|
|
|
981 ;;; (setq cnt (skip-chars-backward "[ \t]"))
|
|
|
982 ;;; (setq target (max (1+ (setq prevc
|
|
|
983 ;;; (current-column))) ; Else indent at comment column
|
|
|
984 ;;; comment-column))
|
|
|
985 ;;; (if (= c comment-column) nil
|
|
|
986 ;;; (delete-backward-char cnt)
|
|
|
987 ;;; (while (< prevc target)
|
|
|
988 ;;; (insert "\t")
|
|
|
989 ;;; (setq prevc (current-column)))
|
|
|
990 ;;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column))))
|
|
|
991 ;;; (while (< prevc target)
|
|
|
992 ;;; (insert " ")
|
|
|
993 ;;; (setq prevc (current-column)))))))
|
|
|
994
|
|
|
995 (defun cperl-indent-for-comment ()
|
|
|
996 "Substite for `indent-for-comment' in CPerl."
|
|
|
997 (interactive)
|
|
|
998 (let (cperl-wrong-comment)
|
|
|
999 (indent-for-comment)
|
|
|
1000 (if cperl-wrong-comment
|
|
|
1001 (progn (cperl-to-comment-or-eol)
|
|
|
1002 (forward-char (length comment-start))))))
|
|
|
1003
|
|
|
1004 (defun cperl-electric-brace (arg &optional only-before)
|
|
|
1005 "Insert character and correct line's indentation.
|
|
|
1006 If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the
|
|
|
1007 place (even in empty line), but not after. If after \")\" and the inserted
|
|
|
1008 char is \"{\", insert extra newline before only if
|
|
|
1009 `cperl-extra-newline-before-brace'."
|
|
|
1010 (interactive "P")
|
|
|
1011 (let (insertpos)
|
|
|
1012 (if (and (not arg) ; No args, end (of empty line or auto)
|
|
|
1013 (eolp)
|
|
|
1014 (or (and (null only-before)
|
|
|
1015 (save-excursion
|
|
|
1016 (skip-chars-backward " \t")
|
|
|
1017 (bolp)))
|
|
|
1018 (and (eq last-command-char ?\{) ; Do not insert newline
|
|
|
1019 ;; if after ")" and `cperl-extra-newline-before-brace'
|
|
|
1020 ;; is nil, do not insert extra newline.
|
|
|
1021 (not cperl-extra-newline-before-brace)
|
|
|
1022 (save-excursion
|
|
|
1023 (skip-chars-backward " \t")
|
|
|
1024 (eq (preceding-char) ?\))))
|
|
|
1025 (if cperl-auto-newline
|
|
|
1026 (progn (cperl-indent-line) (newline) t) nil)))
|
|
|
1027 (progn
|
|
|
1028 (if cperl-auto-newline
|
|
|
1029 (setq insertpos (point)))
|
|
|
1030 (insert last-command-char)
|
|
|
1031 (cperl-indent-line)
|
|
|
1032 (if (and cperl-auto-newline (null only-before))
|
|
|
1033 (progn
|
|
|
1034 (newline)
|
|
|
1035 (cperl-indent-line)))
|
|
|
1036 (save-excursion
|
|
|
1037 (if insertpos (progn (goto-char insertpos)
|
|
|
1038 (search-forward (make-string
|
|
|
1039 1 last-command-char))
|
|
|
1040 (setq insertpos (1- (point)))))
|
|
|
1041 (delete-char -1))))
|
|
|
1042 (if insertpos
|
|
|
1043 (save-excursion
|
|
|
1044 (goto-char insertpos)
|
|
|
1045 (self-insert-command (prefix-numeric-value arg)))
|
|
|
1046 (self-insert-command (prefix-numeric-value arg)))))
|
|
|
1047
|
|
|
1048 (defun cperl-electric-lbrace (arg)
|
|
|
1049 "Insert character, correct line's indentation, correct quoting by space."
|
|
|
1050 (interactive "P")
|
|
|
1051 (let (pos after
|
|
|
1052 (cperl-auto-newline cperl-auto-newline)
|
|
|
1053 (other-end (if (and cperl-electric-parens-mark
|
|
|
1054 (cperl-mark-active)
|
|
|
1055 (> (mark) (point)))
|
|
|
1056 (save-excursion
|
|
|
1057 (goto-char (mark))
|
|
|
1058 (point-marker))
|
|
|
1059 nil)))
|
|
|
1060 (and (cperl-val 'cperl-electric-lbrace-space)
|
|
|
1061 (eq (preceding-char) ?$)
|
|
|
1062 (save-excursion
|
|
|
1063 (skip-chars-backward "$")
|
|
|
1064 (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
|
|
|
1065 (insert ? ))
|
|
|
1066 (if (cperl-after-expr-p nil "{};)") nil (setq cperl-auto-newline nil))
|
|
|
1067 (cperl-electric-brace arg)
|
|
|
1068 (and (cperl-val 'cperl-electric-parens)
|
|
|
1069 (eq last-command-char ?{)
|
|
|
1070 (memq last-command-char
|
|
|
1071 (append cperl-electric-parens-string nil))
|
|
|
1072 (or (if other-end (goto-char (marker-position other-end)))
|
|
|
1073 t)
|
|
|
1074 (setq last-command-char ?} pos (point))
|
|
|
1075 (progn (cperl-electric-brace arg t)
|
|
|
1076 (goto-char pos)))))
|
|
|
1077
|
|
|
1078 (defun cperl-electric-paren (arg)
|
|
|
1079 "Insert a matching pair of parentheses."
|
|
|
1080 (interactive "P")
|
|
|
1081 (let ((beg (save-excursion (beginning-of-line) (point)))
|
|
|
1082 (other-end (if (and cperl-electric-parens-mark
|
|
|
1083 (cperl-mark-active)
|
|
|
1084 (> (mark) (point)))
|
|
|
1085 (save-excursion
|
|
|
1086 (goto-char (mark))
|
|
|
1087 (point-marker))
|
|
|
1088 nil)))
|
|
|
1089 (if (and (cperl-val 'cperl-electric-parens)
|
|
|
1090 (memq last-command-char
|
|
|
1091 (append cperl-electric-parens-string nil))
|
|
|
1092 (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
|
|
|
1093 ;;(not (save-excursion (search-backward "#" beg t)))
|
|
|
1094 (if (eq last-command-char ?<)
|
|
|
1095 (cperl-after-expr-p nil "{};(,:=")
|
|
|
1096 1))
|
|
|
1097 (progn
|
|
|
1098 (insert last-command-char)
|
|
|
1099 (if other-end (goto-char (marker-position other-end)))
|
|
|
1100 (insert (cdr (assoc last-command-char '((?{ .?})
|
|
|
1101 (?[ . ?])
|
|
|
1102 (?( . ?))
|
|
|
1103 (?< . ?>)))))
|
|
|
1104 (forward-char -1))
|
|
|
1105 (insert last-command-char)
|
|
|
1106 )))
|
|
|
1107
|
|
|
1108 (defun cperl-electric-keyword ()
|
|
|
1109 "Insert a construction appropriate after a keyword."
|
|
|
1110 (let ((beg (save-excursion (beginning-of-line) (point)))
|
|
|
1111 (dollar (eq (preceding-char) ?$)))
|
|
|
1112 (and (save-excursion
|
|
|
1113 (backward-sexp 1)
|
|
|
1114 (cperl-after-expr-p nil "{};:"))
|
|
|
1115 (save-excursion
|
|
|
1116 (not
|
|
|
1117 (re-search-backward
|
|
|
1118 "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
|
|
|
1119 beg t)))
|
|
|
1120 (save-excursion (or (not (re-search-backward "^=" nil t))
|
|
|
1121 (looking-at "=cut")))
|
|
|
1122 (progn
|
|
|
1123 (and dollar (insert " $"))
|
|
|
1124 (cperl-indent-line)
|
|
|
1125 ;;(insert " () {\n}")
|
|
|
1126 (cond
|
|
|
1127 (cperl-extra-newline-before-brace
|
|
|
1128 (insert " ()\n")
|
|
|
1129 (insert "{")
|
|
|
1130 (cperl-indent-line)
|
|
|
1131 (insert "\n")
|
|
|
1132 (cperl-indent-line)
|
|
|
1133 (insert "\n}"))
|
|
|
1134 (t
|
|
|
1135 (insert " () {\n}"))
|
|
|
1136 )
|
|
|
1137 (or (looking-at "[ \t]\\|$") (insert " "))
|
|
|
1138 (cperl-indent-line)
|
|
|
1139 (if dollar (progn (search-backward "$")
|
|
|
1140 (forward-char 1))
|
|
|
1141 (search-backward ")"))
|
|
|
1142 (cperl-putback-char del-back-ch)))))
|
|
|
1143
|
|
|
1144 (defun cperl-electric-else ()
|
|
|
1145 "Insert a construction appropriate after a keyword."
|
|
|
1146 (let ((beg (save-excursion (beginning-of-line) (point))))
|
|
|
1147 (and (save-excursion
|
|
|
1148 (backward-sexp 1)
|
|
|
1149 (cperl-after-expr-p nil "{};:"))
|
|
|
1150 (save-excursion
|
|
|
1151 (not
|
|
|
1152 (re-search-backward
|
|
|
1153 "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
|
|
|
1154 beg t)))
|
|
|
1155 (save-excursion (or (not (re-search-backward "^=" nil t))
|
|
|
1156 (looking-at "=cut")))
|
|
|
1157 (progn
|
|
|
1158 (cperl-indent-line)
|
|
|
1159 ;;(insert " {\n\n}")
|
|
|
1160 (cond
|
|
|
1161 (cperl-extra-newline-before-brace
|
|
|
1162 (insert "\n")
|
|
|
1163 (insert "{")
|
|
|
1164 (cperl-indent-line)
|
|
|
1165 (insert "\n\n}"))
|
|
|
1166 (t
|
|
|
1167 (insert " {\n\n}"))
|
|
|
1168 )
|
|
|
1169 (or (looking-at "[ \t]\\|$") (insert " "))
|
|
|
1170 (cperl-indent-line)
|
|
|
1171 (forward-line -1)
|
|
|
1172 (cperl-indent-line)
|
|
|
1173 (cperl-putback-char del-back-ch)))))
|
|
|
1174
|
|
|
1175 (defun cperl-linefeed ()
|
|
|
1176 "Go to end of line, open a new line and indent appropriately."
|
|
|
1177 (interactive)
|
|
|
1178 (let ((beg (save-excursion (beginning-of-line) (point)))
|
|
|
1179 (end (save-excursion (end-of-line) (point)))
|
|
|
1180 (pos (point)) start)
|
|
|
1181 (if (and ; Check if we need to split:
|
|
|
1182 ; i.e., on a boundary and inside "{...}"
|
|
|
1183 (save-excursion (cperl-to-comment-or-eol)
|
|
|
1184 (>= (point) pos))
|
|
|
1185 (or (save-excursion
|
|
|
1186 (skip-chars-backward " \t" beg)
|
|
|
1187 (forward-char -1)
|
|
|
1188 (looking-at "[;{]"))
|
|
|
1189 (looking-at "[ \t]*}")
|
|
|
1190 (re-search-forward "\\=[ \t]*;" end t))
|
|
|
1191 (save-excursion
|
|
|
1192 (and
|
|
|
1193 (eq (car (parse-partial-sexp pos end -1)) -1)
|
|
|
1194 (looking-at "[,; \t]*\\($\\|#\\)") ; Comma to allow anon subr
|
|
|
1195 (progn
|
|
|
1196 (backward-sexp 1)
|
|
|
1197 (setq start (point-marker))
|
|
|
1198 (<= start pos)))))
|
|
|
1199 (progn
|
|
|
1200 (skip-chars-backward " \t")
|
|
|
1201 (or (memq (preceding-char) (append ";{" nil))
|
|
|
1202 (insert ";"))
|
|
|
1203 (insert "\n")
|
|
|
1204 (forward-line -1)
|
|
|
1205 (cperl-indent-line)
|
|
|
1206 (goto-char start)
|
|
|
1207 (or (looking-at "{[ \t]*$") ; If there is a statement
|
|
|
1208 ; before, move it to separate line
|
|
|
1209 (progn
|
|
|
1210 (forward-char 1)
|
|
|
1211 (insert "\n")
|
|
|
1212 (cperl-indent-line)))
|
|
|
1213 (forward-line 1) ; We are on the target line
|
|
|
1214 (cperl-indent-line)
|
|
|
1215 (beginning-of-line)
|
|
|
1216 (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement
|
|
|
1217 ; after, move it to separate line
|
|
|
1218 (progn
|
|
|
1219 (end-of-line)
|
|
|
1220 (search-backward "}" beg)
|
|
|
1221 (skip-chars-backward " \t")
|
|
|
1222 (or (memq (preceding-char) (append ";{" nil))
|
|
|
1223 (insert ";"))
|
|
|
1224 (insert "\n")
|
|
|
1225 (cperl-indent-line)
|
|
|
1226 (forward-line -1)))
|
|
|
1227 (forward-line -1) ; We are on the line before target
|
|
|
1228 (end-of-line)
|
|
|
1229 (newline-and-indent))
|
|
|
1230 (end-of-line) ; else
|
|
|
1231 (if (not (looking-at "\n[ \t]*$"))
|
|
|
1232 (newline-and-indent)
|
|
|
1233 (forward-line 1)
|
|
|
1234 (cperl-indent-line)))))
|
|
|
1235
|
|
|
1236 (defun cperl-electric-semi (arg)
|
|
|
1237 "Insert character and correct line's indentation."
|
|
|
1238 (interactive "P")
|
|
|
1239 (if cperl-auto-newline
|
|
|
1240 (cperl-electric-terminator arg)
|
|
|
1241 (self-insert-command (prefix-numeric-value arg))))
|
|
|
1242
|
|
|
1243 (defun cperl-electric-terminator (arg)
|
|
|
1244 "Insert character and correct line's indentation."
|
|
|
1245 (interactive "P")
|
|
|
1246 (let (insertpos (end (point))
|
|
|
1247 (auto (and cperl-auto-newline
|
|
|
1248 (or (not (eq last-command-char ?:))
|
|
|
1249 cperl-auto-newline-after-colon))))
|
|
|
1250 (if (and (not arg) (eolp)
|
|
|
1251 (not (save-excursion
|
|
|
1252 (beginning-of-line)
|
|
|
1253 (skip-chars-forward " \t")
|
|
|
1254 (or
|
|
|
1255 ;; Ignore in comment lines
|
|
|
1256 (= (following-char) ?#)
|
|
|
1257 ;; Colon is special only after a label
|
|
|
1258 ;; So quickly rule out most other uses of colon
|
|
|
1259 ;; and do no indentation for them.
|
|
|
1260 (and (eq last-command-char ?:)
|
|
|
1261 (save-excursion
|
|
|
1262 (forward-word 1)
|
|
|
1263 (skip-chars-forward " \t")
|
|
|
1264 (and (< (point) end)
|
|
|
1265 (progn (goto-char (- end 1))
|
|
|
1266 (not (looking-at ":"))))))
|
|
|
1267 (progn
|
|
|
1268 (beginning-of-defun)
|
|
|
1269 (let ((pps (parse-partial-sexp (point) end)))
|
|
|
1270 (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
|
|
|
1271 (progn
|
|
|
1272 (insert last-command-char)
|
|
|
1273 (forward-char -1)
|
|
|
1274 (if auto (setq insertpos (point-marker)))
|
|
|
1275 (forward-char 1)
|
|
|
1276 (cperl-indent-line)
|
|
|
1277 (if auto
|
|
|
1278 (progn
|
|
|
1279 (newline)
|
|
|
1280 (cperl-indent-line)))
|
|
|
1281 ;; (save-excursion
|
|
|
1282 ;; (if insertpos (progn (goto-char (marker-position insertpos))
|
|
|
1283 ;; (search-forward (make-string
|
|
|
1284 ;; 1 last-command-char))
|
|
|
1285 ;; (setq insertpos (1- (point)))))
|
|
|
1286 ;; (delete-char -1))))
|
|
|
1287 (save-excursion
|
|
|
1288 (if insertpos (goto-char (marker-position insertpos))
|
|
|
1289 (forward-char -1))
|
|
|
1290 (delete-char 1))))
|
|
|
1291 (if insertpos
|
|
|
1292 (save-excursion
|
|
|
1293 (goto-char insertpos)
|
|
|
1294 (self-insert-command (prefix-numeric-value arg)))
|
|
|
1295 (self-insert-command (prefix-numeric-value arg)))))
|
|
|
1296
|
|
|
1297 (defun cperl-electric-backspace (arg)
|
|
|
1298 "Backspace-untabify, or remove the whitespace inserted by an electric key."
|
|
|
1299 (interactive "p")
|
|
|
1300 (if (and cperl-auto-newline
|
|
|
1301 (memq last-command '(cperl-electric-semi
|
|
|
1302 cperl-electric-terminator
|
|
|
1303 cperl-electric-lbrace))
|
|
|
1304 (memq (preceding-char) '(? ?\t ?\n)))
|
|
|
1305 (let (p)
|
|
|
1306 (if (eq last-command 'cperl-electric-lbrace)
|
|
|
1307 (skip-chars-forward " \t\n"))
|
|
|
1308 (setq p (point))
|
|
|
1309 (skip-chars-backward " \t\n")
|
|
|
1310 (delete-region (point) p))
|
|
|
1311 (backward-delete-char-untabify arg)))
|
|
|
1312
|
|
|
1313 (defun cperl-inside-parens-p ()
|
|
|
1314 (condition-case ()
|
|
|
1315 (save-excursion
|
|
|
1316 (save-restriction
|
|
|
1317 (narrow-to-region (point)
|
|
|
1318 (progn (beginning-of-defun) (point)))
|
|
|
1319 (goto-char (point-max))
|
|
|
1320 (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
|
|
|
1321 (error nil)))
|
|
|
1322
|
|
|
1323 (defun cperl-indent-command (&optional whole-exp)
|
|
|
1324 (interactive "P")
|
|
|
1325 "Indent current line as Perl code, or in some cases insert a tab character.
|
|
|
1326 If `cperl-tab-always-indent' is non-nil (the default), always indent current line.
|
|
|
1327 Otherwise, indent the current line only if point is at the left margin
|
|
|
1328 or in the line's indentation; otherwise insert a tab.
|
|
|
1329
|
|
|
1330 A numeric argument, regardless of its value,
|
|
|
1331 means indent rigidly all the lines of the expression starting after point
|
|
|
1332 so that this line becomes properly indented.
|
|
|
1333 The relative indentation among the lines of the expression are preserved."
|
|
|
1334 (if whole-exp
|
|
|
1335 ;; If arg, always indent this line as Perl
|
|
|
1336 ;; and shift remaining lines of expression the same amount.
|
|
|
1337 (let ((shift-amt (cperl-indent-line))
|
|
|
1338 beg end)
|
|
|
1339 (save-excursion
|
|
|
1340 (if cperl-tab-always-indent
|
|
|
1341 (beginning-of-line))
|
|
|
1342 (setq beg (point))
|
|
|
1343 (forward-sexp 1)
|
|
|
1344 (setq end (point))
|
|
|
1345 (goto-char beg)
|
|
|
1346 (forward-line 1)
|
|
|
1347 (setq beg (point)))
|
|
|
1348 (if (> end beg)
|
|
|
1349 (indent-code-rigidly beg end shift-amt "#")))
|
|
|
1350 (if (and (not cperl-tab-always-indent)
|
|
|
1351 (save-excursion
|
|
|
1352 (skip-chars-backward " \t")
|
|
|
1353 (not (bolp))))
|
|
|
1354 (insert-tab)
|
|
|
1355 (cperl-indent-line))))
|
|
|
1356
|
|
|
1357 (defun cperl-indent-line (&optional symbol)
|
|
|
1358 "Indent current line as Perl code.
|
|
|
1359 Return the amount the indentation changed by."
|
|
|
1360 (let (indent
|
|
|
1361 beg shift-amt
|
|
|
1362 (case-fold-search nil)
|
|
|
1363 (pos (- (point-max) (point))))
|
|
|
1364 (setq indent (cperl-calculate-indent nil symbol))
|
|
|
1365 (beginning-of-line)
|
|
|
1366 (setq beg (point))
|
|
|
1367 (cond ((eq indent nil)
|
|
|
1368 (setq indent (current-indentation)))
|
|
|
1369 ;;((eq indent t) ; Never?
|
|
|
1370 ;; (setq indent (cperl-calculate-indent-within-comment)))
|
|
|
1371 ;;((looking-at "[ \t]*#")
|
|
|
1372 ;; (setq indent 0))
|
|
|
1373 (t
|
|
|
1374 (skip-chars-forward " \t")
|
|
|
1375 (if (listp indent) (setq indent (car indent)))
|
|
|
1376 (cond ((looking-at "[A-Za-z]+:[^:]")
|
|
|
1377 (and (> indent 0)
|
|
|
1378 (setq indent (max cperl-min-label-indent
|
|
|
1379 (+ indent cperl-label-offset)))))
|
|
|
1380 ((= (following-char) ?})
|
|
|
1381 (setq indent (- indent cperl-indent-level)))
|
|
|
1382 ((memq (following-char) '(?\) ?\])) ; To line up with opening paren.
|
|
|
1383 (setq indent (+ indent cperl-close-paren-offset)))
|
|
|
1384 ((= (following-char) ?{)
|
|
|
1385 (setq indent (+ indent cperl-brace-offset))))))
|
|
|
1386 (skip-chars-forward " \t")
|
|
|
1387 (setq shift-amt (- indent (current-column)))
|
|
|
1388 (if (zerop shift-amt)
|
|
|
1389 (if (> (- (point-max) pos) (point))
|
|
|
1390 (goto-char (- (point-max) pos)))
|
|
|
1391 (delete-region beg (point))
|
|
|
1392 (indent-to indent)
|
|
|
1393 ;; If initial point was within line's indentation,
|
|
|
1394 ;; position after the indentation. Else stay at same point in text.
|
|
|
1395 (if (> (- (point-max) pos) (point))
|
|
|
1396 (goto-char (- (point-max) pos))))
|
|
|
1397 shift-amt))
|
|
|
1398
|
|
|
1399 (defun cperl-after-label ()
|
|
|
1400 ;; Returns true if the point is after label. Does not do save-excursion.
|
|
|
1401 (and (eq (preceding-char) ?:)
|
|
|
1402 (memq (char-syntax (char-after (- (point) 2)))
|
|
|
1403 '(?w ?_))
|
|
|
1404 (progn
|
|
|
1405 (backward-sexp)
|
|
|
1406 (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:"))))
|
|
|
1407
|
|
|
1408 (defun cperl-get-state (&optional parse-start start-state)
|
|
|
1409 ;; returns list (START STATE DEPTH PRESTART), START is a good place
|
|
|
1410 ;; to start parsing, STATE is what is returned by
|
|
|
1411 ;; `parse-partial-sexp'. DEPTH is true is we are immediately after
|
|
|
1412 ;; end of block which contains START. PRESTART is the position
|
|
|
1413 ;; basing on which START was found.
|
|
|
1414 (save-excursion
|
|
|
1415 (let ((start-point (point)) depth state start prestart)
|
|
|
1416 (if parse-start
|
|
|
1417 (goto-char parse-start)
|
|
|
1418 (beginning-of-defun))
|
|
|
1419 (setq prestart (point))
|
|
|
1420 (if start-state nil
|
|
|
1421 ;; Try to go out, if sub is not on the outermost level
|
|
|
1422 (while (< (point) start-point)
|
|
|
1423 (setq start (point) parse-start start depth nil
|
|
|
1424 state (parse-partial-sexp start start-point -1))
|
|
|
1425 (if (> (car state) -1) nil
|
|
|
1426 ;; The current line could start like }}}, so the indentation
|
|
|
1427 ;; corresponds to a different level than what we reached
|
|
|
1428 (setq depth t)
|
|
|
1429 (beginning-of-line 2))) ; Go to the next line.
|
|
|
1430 (if start (goto-char start))) ; Not at the start of file
|
|
|
1431 (setq start (point))
|
|
|
1432 (if (< start start-point) (setq parse-start start))
|
|
|
1433 (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
|
|
|
1434 (list start state depth prestart))))
|
|
|
1435
|
|
|
1436 (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" !
|
|
|
1437 ;; Positions is before ?\{. Checks whether it starts a block.
|
|
|
1438 ;; No save-excursion!
|
|
|
1439 (cperl-backward-to-noncomment (point-min))
|
|
|
1440 ;;(skip-chars-backward " \t\n\f")
|
|
|
1441 (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp
|
|
|
1442 ; Label may be mixed up with `$blah :'
|
|
|
1443 (save-excursion (cperl-after-label))
|
|
|
1444 (and (eq (char-syntax (preceding-char)) ?w)
|
|
|
1445 (progn
|
|
|
1446 (backward-sexp)
|
|
|
1447 ;; Need take into account `bless', `return', `tr',...
|
|
|
1448 (or (and (looking-at "\\sw+[ \t\n\f]*[{#]") ; Method call syntax
|
|
|
1449 (not (looking-at "\\(bless\\|return\\|qw\\|tr\\|[smy]\\)\\>")))
|
|
|
1450 (progn
|
|
|
1451 (skip-chars-backward " \t\n\f")
|
|
|
1452 (and (eq (char-syntax (preceding-char)) ?w)
|
|
|
1453 (progn
|
|
|
1454 (backward-sexp)
|
|
|
1455 (looking-at
|
|
|
1456 "sub[ \t]+\\sw+[ \t\n\f]*[#{]")))))))))
|
|
|
1457
|
|
|
1458 (defun cperl-calculate-indent (&optional parse-start symbol)
|
|
|
1459 "Return appropriate indentation for current line as Perl code.
|
|
|
1460 In usual case returns an integer: the column to indent to.
|
|
|
1461 Returns nil if line starts inside a string, t if in a comment."
|
|
|
1462 (save-excursion
|
|
|
1463 (if (memq (get-text-property (point) 'syntax-type) '(pod here-doc)) nil
|
|
|
1464 (beginning-of-line)
|
|
|
1465 (let* ((indent-point (point))
|
|
|
1466 (case-fold-search nil)
|
|
|
1467 (s-s (cperl-get-state))
|
|
|
1468 (start (nth 0 s-s))
|
|
|
1469 (state (nth 1 s-s))
|
|
|
1470 (containing-sexp (car (cdr state)))
|
|
|
1471 (char-after (save-excursion
|
|
|
1472 (skip-chars-forward " \t")
|
|
|
1473 (following-char)))
|
|
|
1474 (start-indent (save-excursion
|
|
|
1475 (goto-char start)
|
|
|
1476 (- (current-indentation)
|
|
|
1477 (if (nth 2 s-s) cperl-indent-level 0))))
|
|
|
1478 old-indent)
|
|
|
1479 ;; (or parse-start (null symbol)
|
|
|
1480 ;; (setq parse-start (symbol-value symbol)
|
|
|
1481 ;; start-indent (nth 2 parse-start)
|
|
|
1482 ;; parse-start (car parse-start)))
|
|
|
1483 ;; (if parse-start
|
|
|
1484 ;; (goto-char parse-start)
|
|
|
1485 ;; (beginning-of-defun))
|
|
|
1486 ;; ;; Try to go out
|
|
|
1487 ;; (while (< (point) indent-point)
|
|
|
1488 ;; (setq start (point) parse-start start moved nil
|
|
|
1489 ;; state (parse-partial-sexp start indent-point -1))
|
|
|
1490 ;; (if (> (car state) -1) nil
|
|
|
1491 ;; ;; The current line could start like }}}, so the indentation
|
|
|
1492 ;; ;; corresponds to a different level than what we reached
|
|
|
1493 ;; (setq moved t)
|
|
|
1494 ;; (beginning-of-line 2))) ; Go to the next line.
|
|
|
1495 ;; (if start ; Not at the start of file
|
|
|
1496 ;; (progn
|
|
|
1497 ;; (goto-char start)
|
|
|
1498 ;; (setq start-indent (current-indentation))
|
|
|
1499 ;; (if moved ; Should correct...
|
|
|
1500 ;; (setq start-indent (- start-indent cperl-indent-level))))
|
|
|
1501 ;; (setq start-indent 0))
|
|
|
1502 ;; (if (< (point) indent-point) (setq parse-start (point)))
|
|
|
1503 ;; (or state (setq state (parse-partial-sexp
|
|
|
1504 ;; (point) indent-point -1 nil start-state)))
|
|
|
1505 ;; (setq containing-sexp
|
|
|
1506 ;; (or (car (cdr state))
|
|
|
1507 ;; (and (>= (nth 6 state) 0) old-containing-sexp))
|
|
|
1508 ;; old-containing-sexp nil start-state nil)
|
|
|
1509 ;;;; (while (< (point) indent-point)
|
|
|
1510 ;;;; (setq parse-start (point))
|
|
|
1511 ;;;; (setq state (parse-partial-sexp (point) indent-point -1 nil start-state))
|
|
|
1512 ;;;; (setq containing-sexp
|
|
|
1513 ;;;; (or (car (cdr state))
|
|
|
1514 ;;;; (and (>= (nth 6 state) 0) old-containing-sexp))
|
|
|
1515 ;;;; old-containing-sexp nil start-state nil))
|
|
|
1516 ;; (if symbol (set symbol (list indent-point state start-indent)))
|
|
|
1517 ;; (goto-char indent-point)
|
|
|
1518 (cond ((or (nth 3 state) (nth 4 state))
|
|
|
1519 ;; return nil or t if should not change this line
|
|
|
1520 (nth 4 state))
|
|
|
1521 ((null containing-sexp)
|
|
|
1522 ;; Line is at top level. May be data or function definition,
|
|
|
1523 ;; or may be function argument declaration.
|
|
|
1524 ;; Indent like the previous top level line
|
|
|
1525 ;; unless that ends in a closeparen without semicolon,
|
|
|
1526 ;; in which case this line is the first argument decl.
|
|
|
1527 (skip-chars-forward " \t")
|
|
|
1528 (+ start-indent
|
|
|
1529 (if (= (following-char) ?{) cperl-continued-brace-offset 0)
|
|
|
1530 (progn
|
|
|
1531 (cperl-backward-to-noncomment (or parse-start (point-min)))
|
|
|
1532 ;;(skip-chars-backward " \t\f\n")
|
|
|
1533 ;; Look at previous line that's at column 0
|
|
|
1534 ;; to determine whether we are in top-level decls
|
|
|
1535 ;; or function's arg decls. Set basic-indent accordingly.
|
|
|
1536 ;; Now add a little if this is a continuation line.
|
|
|
1537 (if (or (bobp)
|
|
|
1538 (memq (preceding-char) (append " ;}" nil)) ; Was ?\)
|
|
|
1539 (memq char-after (append ")]}" nil)))
|
|
|
1540 0
|
|
|
1541 cperl-continued-statement-offset))))
|
|
|
1542 ((/= (char-after containing-sexp) ?{)
|
|
|
1543 ;; line is expression, not statement:
|
|
|
1544 ;; indent to just after the surrounding open,
|
|
|
1545 ;; skip blanks if we do not close the expression.
|
|
|
1546 (goto-char (1+ containing-sexp))
|
|
|
1547 (or (memq char-after (append ")]}" nil))
|
|
|
1548 (looking-at "[ \t]*\\(#\\|$\\)")
|
|
|
1549 (skip-chars-forward " \t"))
|
|
|
1550 (current-column))
|
|
|
1551 ((progn
|
|
|
1552 ;; Containing-expr starts with \{. Check whether it is a hash.
|
|
|
1553 (goto-char containing-sexp)
|
|
|
1554 (not (cperl-block-p)))
|
|
|
1555 (goto-char (1+ containing-sexp))
|
|
|
1556 (or (eq char-after ?\})
|
|
|
1557 (looking-at "[ \t]*\\(#\\|$\\)")
|
|
|
1558 (skip-chars-forward " \t"))
|
|
|
1559 (+ (current-column) ; Correct indentation of trailing ?\}
|
|
|
1560 (if (eq char-after ?\}) (+ cperl-indent-level
|
|
|
1561 cperl-close-paren-offset)
|
|
|
1562 0)))
|
|
|
1563 (t
|
|
|
1564 ;; Statement level. Is it a continuation or a new statement?
|
|
|
1565 ;; Find previous non-comment character.
|
|
|
1566 (goto-char indent-point)
|
|
|
1567 (cperl-backward-to-noncomment containing-sexp)
|
|
|
1568 ;; Back up over label lines, since they don't
|
|
|
1569 ;; affect whether our line is a continuation.
|
|
|
1570 (while (or (eq (preceding-char) ?\,)
|
|
|
1571 (and (eq (preceding-char) ?:)
|
|
|
1572 (or;;(eq (char-after (- (point) 2)) ?\') ; ????
|
|
|
1573 (memq (char-syntax (char-after (- (point) 2)))
|
|
|
1574 '(?w ?_)))))
|
|
|
1575 (if (eq (preceding-char) ?\,)
|
|
|
1576 ;; Will go to beginning of line, essentially.
|
|
|
1577 ;; Will ignore embedded sexpr XXXX.
|
|
|
1578 (cperl-backward-to-start-of-continued-exp containing-sexp))
|
|
|
1579 (beginning-of-line)
|
|
|
1580 (cperl-backward-to-noncomment containing-sexp))
|
|
|
1581 ;; Now we get the answer.
|
|
|
1582 (if (not (memq (preceding-char) (append ", ;}{" '(nil)))) ; Was ?\,
|
|
|
1583 ;; This line is continuation of preceding line's statement;
|
|
|
1584 ;; indent `cperl-continued-statement-offset' more than the
|
|
|
1585 ;; previous line of the statement.
|
|
|
1586 (progn
|
|
|
1587 (cperl-backward-to-start-of-continued-exp containing-sexp)
|
|
|
1588 (+ (if (memq char-after (append "}])" nil))
|
|
|
1589 0 ; Closing parenth
|
|
|
1590 cperl-continued-statement-offset)
|
|
|
1591 (current-column)
|
|
|
1592 (if (eq char-after ?\{)
|
|
|
1593 cperl-continued-brace-offset 0)))
|
|
|
1594 ;; This line starts a new statement.
|
|
|
1595 ;; Position following last unclosed open.
|
|
|
1596 (goto-char containing-sexp)
|
|
|
1597 ;; Is line first statement after an open-brace?
|
|
|
1598 (or
|
|
|
1599 ;; If no, find that first statement and indent like
|
|
|
1600 ;; it. If the first statement begins with label, do
|
|
|
1601 ;; not belive when the indentation of the label is too
|
|
|
1602 ;; small.
|
|
|
1603 (save-excursion
|
|
|
1604 (forward-char 1)
|
|
|
1605 (setq old-indent (current-indentation))
|
|
|
1606 (let ((colon-line-end 0))
|
|
|
1607 (while (progn (skip-chars-forward " \t\n")
|
|
|
1608 (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]"))
|
|
|
1609 ;; Skip over comments and labels following openbrace.
|
|
|
1610 (cond ((= (following-char) ?\#)
|
|
|
1611 (forward-line 1))
|
|
|
1612 ;; label:
|
|
|
1613 (t
|
|
|
1614 (save-excursion (end-of-line)
|
|
|
1615 (setq colon-line-end (point)))
|
|
|
1616 (search-forward ":"))))
|
|
|
1617 ;; The first following code counts
|
|
|
1618 ;; if it is before the line we want to indent.
|
|
|
1619 (and (< (point) indent-point)
|
|
|
1620 (if (> colon-line-end (point)) ; After label
|
|
|
1621 (if (> (current-indentation)
|
|
|
1622 cperl-min-label-indent)
|
|
|
1623 (- (current-indentation) cperl-label-offset)
|
|
|
1624 ;; Do not belive: `max' is involved
|
|
|
1625 (+ old-indent cperl-indent-level))
|
|
|
1626 (current-column)))))
|
|
|
1627 ;; If no previous statement,
|
|
|
1628 ;; indent it relative to line brace is on.
|
|
|
1629 ;; For open brace in column zero, don't let statement
|
|
|
1630 ;; start there too. If cperl-indent-level is zero,
|
|
|
1631 ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
|
|
|
1632 ;; For open-braces not the first thing in a line,
|
|
|
1633 ;; add in cperl-brace-imaginary-offset.
|
|
|
1634
|
|
|
1635 ;; If first thing on a line: ?????
|
|
|
1636 (+ (if (and (bolp) (zerop cperl-indent-level))
|
|
|
1637 (+ cperl-brace-offset cperl-continued-statement-offset)
|
|
|
1638 cperl-indent-level)
|
|
|
1639 ;; Move back over whitespace before the openbrace.
|
|
|
1640 ;; If openbrace is not first nonwhite thing on the line,
|
|
|
1641 ;; add the cperl-brace-imaginary-offset.
|
|
|
1642 (progn (skip-chars-backward " \t")
|
|
|
1643 (if (bolp) 0 cperl-brace-imaginary-offset))
|
|
|
1644 ;; If the openbrace is preceded by a parenthesized exp,
|
|
|
1645 ;; move to the beginning of that;
|
|
|
1646 ;; possibly a different line
|
|
|
1647 (progn
|
|
|
1648 (if (eq (preceding-char) ?\))
|
|
|
1649 (forward-sexp -1))
|
|
|
1650 ;; In the case it starts a subroutine, indent with
|
|
|
1651 ;; respect to `sub', not with respect to the the
|
|
|
1652 ;; first thing on the line, say in the case of
|
|
|
1653 ;; anonymous sub in a hash.
|
|
|
1654 ;;
|
|
|
1655 (skip-chars-backward " \t")
|
|
|
1656 (if (and (eq (preceding-char) ?b)
|
|
|
1657 (progn
|
|
|
1658 (forward-word -1)
|
|
|
1659 (looking-at "sub\\>"))
|
|
|
1660 (setq old-indent
|
|
|
1661 (nth 1
|
|
|
1662 (parse-partial-sexp
|
|
|
1663 (save-excursion (beginning-of-line) (point))
|
|
|
1664 (point)))))
|
|
|
1665 (progn (goto-char (1+ old-indent))
|
|
|
1666 (skip-chars-forward " \t")
|
|
|
1667 (current-column))
|
|
|
1668 ;; Get initial indentation of the line we are on.
|
|
|
1669 ;; If line starts with label, calculate label indentation
|
|
|
1670 (if (save-excursion
|
|
|
1671 (beginning-of-line)
|
|
|
1672 (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
|
|
|
1673 (if (> (current-indentation) cperl-min-label-indent)
|
|
|
1674 (- (current-indentation) cperl-label-offset)
|
|
|
1675 (cperl-calculate-indent
|
|
|
1676 (if (and parse-start (<= parse-start (point)))
|
|
|
1677 parse-start)))
|
|
|
1678 (current-indentation)))))))))))))
|
|
|
1679
|
|
|
1680 (defvar cperl-indent-alist
|
|
|
1681 '((string nil)
|
|
|
1682 (comment nil)
|
|
|
1683 (toplevel 0)
|
|
|
1684 (toplevel-after-parenth 2)
|
|
|
1685 (toplevel-continued 2)
|
|
|
1686 (expression 1))
|
|
|
1687 "Alist of indentation rules for CPerl mode.
|
|
|
1688 The values mean:
|
|
|
1689 nil: do not indent;
|
|
|
1690 number: add this amount of indentation.")
|
|
|
1691
|
|
|
1692 (defun cperl-where-am-i (&optional parse-start start-state)
|
|
|
1693 ;; Unfinished
|
|
|
1694 "Return a list of lists ((TYPE POS)...) of good points before the point.
|
|
|
1695 POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
|
|
|
1696 (save-excursion
|
|
|
1697 (let* ((start-point (point))
|
|
|
1698 (s-s (cperl-get-state))
|
|
|
1699 (start (nth 0 s-s))
|
|
|
1700 (state (nth 1 s-s))
|
|
|
1701 (prestart (nth 3 s-s))
|
|
|
1702 (containing-sexp (car (cdr state)))
|
|
|
1703 (case-fold-search nil)
|
|
|
1704 (res (list (list 'parse-start start) (list 'parse-prestart prestart))))
|
|
|
1705 (cond ((nth 3 state) ; In string
|
|
|
1706 (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string
|
|
|
1707 ((nth 4 state) ; In comment
|
|
|
1708 (setq res (cons '(comment) res)))
|
|
|
1709 ((null containing-sexp)
|
|
|
1710 ;; Line is at top level.
|
|
|
1711 ;; Indent like the previous top level line
|
|
|
1712 ;; unless that ends in a closeparen without semicolon,
|
|
|
1713 ;; in which case this line is the first argument decl.
|
|
|
1714 (cperl-backward-to-noncomment (or parse-start (point-min)))
|
|
|
1715 ;;(skip-chars-backward " \t\f\n")
|
|
|
1716 (cond
|
|
|
1717 ((or (bobp)
|
|
|
1718 (memq (preceding-char) (append ";}" nil)))
|
|
|
1719 (setq res (cons (list 'toplevel start) res)))
|
|
|
1720 ((eq (preceding-char) ?\) )
|
|
|
1721 (setq res (cons (list 'toplevel-after-parenth start) res)))
|
|
|
1722 (t
|
|
|
1723 (setq res (cons (list 'toplevel-continued start) res)))))
|
|
|
1724 ((/= (char-after containing-sexp) ?{)
|
|
|
1725 ;; line is expression, not statement:
|
|
|
1726 ;; indent to just after the surrounding open.
|
|
|
1727 ;; skip blanks if we do not close the expression.
|
|
|
1728 (setq res (cons (list 'expression-blanks
|
|
|
1729 (progn
|
|
|
1730 (goto-char (1+ containing-sexp))
|
|
|
1731 (or (looking-at "[ \t]*\\(#\\|$\\)")
|
|
|
1732 (skip-chars-forward " \t"))
|
|
|
1733 (point)))
|
|
|
1734 (cons (list 'expression containing-sexp) res))))
|
|
|
1735 ((progn
|
|
|
1736 ;; Containing-expr starts with \{. Check whether it is a hash.
|
|
|
1737 (goto-char containing-sexp)
|
|
|
1738 (not (cperl-block-p)))
|
|
|
1739 (setq res (cons (list 'expression-blanks
|
|
|
1740 (progn
|
|
|
1741 (goto-char (1+ containing-sexp))
|
|
|
1742 (or (looking-at "[ \t]*\\(#\\|$\\)")
|
|
|
1743 (skip-chars-forward " \t"))
|
|
|
1744 (point)))
|
|
|
1745 (cons (list 'expression containing-sexp) res))))
|
|
|
1746 (t
|
|
|
1747 ;; Statement level.
|
|
|
1748 (setq res (cons (list 'in-block containing-sexp) res))
|
|
|
1749 ;; Is it a continuation or a new statement?
|
|
|
1750 ;; Find previous non-comment character.
|
|
|
1751 (cperl-backward-to-noncomment containing-sexp)
|
|
|
1752 ;; Back up over label lines, since they don't
|
|
|
1753 ;; affect whether our line is a continuation.
|
|
|
1754 ;; Back up comma-delimited lines too ?????
|
|
|
1755 (while (or (eq (preceding-char) ?\,)
|
|
|
1756 (save-excursion (cperl-after-label)))
|
|
|
1757 (if (eq (preceding-char) ?\,)
|
|
|
1758 ;; Will go to beginning of line, essentially
|
|
|
1759 ;; Will ignore embedded sexpr XXXX.
|
|
|
1760 (cperl-backward-to-start-of-continued-exp containing-sexp))
|
|
|
1761 (beginning-of-line)
|
|
|
1762 (cperl-backward-to-noncomment containing-sexp))
|
|
|
1763 ;; Now we get the answer.
|
|
|
1764 (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\,
|
|
|
1765 ;; This line is continuation of preceding line's statement.
|
|
|
1766 (list (list 'statement-continued containing-sexp))
|
|
|
1767 ;; This line starts a new statement.
|
|
|
1768 ;; Position following last unclosed open.
|
|
|
1769 (goto-char containing-sexp)
|
|
|
1770 ;; Is line first statement after an open-brace?
|
|
|
1771 (or
|
|
|
1772 ;; If no, find that first statement and indent like
|
|
|
1773 ;; it. If the first statement begins with label, do
|
|
|
1774 ;; not belive when the indentation of the label is too
|
|
|
1775 ;; small.
|
|
|
1776 (save-excursion
|
|
|
1777 (forward-char 1)
|
|
|
1778 (let ((colon-line-end 0))
|
|
|
1779 (while (progn (skip-chars-forward " \t\n" start-point)
|
|
|
1780 (and (< (point) start-point)
|
|
|
1781 (looking-at
|
|
|
1782 "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))
|
|
|
1783 ;; Skip over comments and labels following openbrace.
|
|
|
1784 (cond ((= (following-char) ?\#)
|
|
|
1785 ;;(forward-line 1)
|
|
|
1786 (end-of-line))
|
|
|
1787 ;; label:
|
|
|
1788 (t
|
|
|
1789 (save-excursion (end-of-line)
|
|
|
1790 (setq colon-line-end (point)))
|
|
|
1791 (search-forward ":"))))
|
|
|
1792 ;; Now at the point, after label, or at start
|
|
|
1793 ;; of first statement in the block.
|
|
|
1794 (and (< (point) start-point)
|
|
|
1795 (if (> colon-line-end (point))
|
|
|
1796 ;; Before statement after label
|
|
|
1797 (if (> (current-indentation)
|
|
|
1798 cperl-min-label-indent)
|
|
|
1799 (list (list 'label-in-block (point)))
|
|
|
1800 ;; Do not belive: `max' is involved
|
|
|
1801 (list
|
|
|
1802 (list 'label-in-block-min-indent (point))))
|
|
|
1803 ;; Before statement
|
|
|
1804 (list 'statement-in-block (point))))))
|
|
|
1805 ;; If no previous statement,
|
|
|
1806 ;; indent it relative to line brace is on.
|
|
|
1807 ;; For open brace in column zero, don't let statement
|
|
|
1808 ;; start there too. If cperl-indent-level is zero,
|
|
|
1809 ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
|
|
|
1810 ;; For open-braces not the first thing in a line,
|
|
|
1811 ;; add in cperl-brace-imaginary-offset.
|
|
|
1812
|
|
|
1813 ;; If first thing on a line: ?????
|
|
|
1814 (+ (if (and (bolp) (zerop cperl-indent-level))
|
|
|
1815 (+ cperl-brace-offset cperl-continued-statement-offset)
|
|
|
1816 cperl-indent-level)
|
|
|
1817 ;; Move back over whitespace before the openbrace.
|
|
|
1818 ;; If openbrace is not first nonwhite thing on the line,
|
|
|
1819 ;; add the cperl-brace-imaginary-offset.
|
|
|
1820 (progn (skip-chars-backward " \t")
|
|
|
1821 (if (bolp) 0 cperl-brace-imaginary-offset))
|
|
|
1822 ;; If the openbrace is preceded by a parenthesized exp,
|
|
|
1823 ;; move to the beginning of that;
|
|
|
1824 ;; possibly a different line
|
|
|
1825 (progn
|
|
|
1826 (if (eq (preceding-char) ?\))
|
|
|
1827 (forward-sexp -1))
|
|
|
1828 ;; Get initial indentation of the line we are on.
|
|
|
1829 ;; If line starts with label, calculate label indentation
|
|
|
1830 (if (save-excursion
|
|
|
1831 (beginning-of-line)
|
|
|
1832 (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
|
|
|
1833 (if (> (current-indentation) cperl-min-label-indent)
|
|
|
1834 (- (current-indentation) cperl-label-offset)
|
|
|
1835 (cperl-calculate-indent
|
|
|
1836 (if (and parse-start (<= parse-start (point)))
|
|
|
1837 parse-start)))
|
|
|
1838 (current-indentation))))))))
|
|
|
1839 res)))
|
|
|
1840
|
|
|
1841 (defun cperl-calculate-indent-within-comment ()
|
|
|
1842 "Return the indentation amount for line, assuming that
|
|
|
1843 the current line is to be regarded as part of a block comment."
|
|
|
1844 (let (end star-start)
|
|
|
1845 (save-excursion
|
|
|
1846 (beginning-of-line)
|
|
|
1847 (skip-chars-forward " \t")
|
|
|
1848 (setq end (point))
|
|
|
1849 (and (= (following-char) ?#)
|
|
|
1850 (forward-line -1)
|
|
|
1851 (cperl-to-comment-or-eol)
|
|
|
1852 (setq end (point)))
|
|
|
1853 (goto-char end)
|
|
|
1854 (current-column))))
|
|
|
1855
|
|
|
1856
|
|
|
1857 (defun cperl-to-comment-or-eol ()
|
|
|
1858 "Goes to position before comment on the current line, or to end of line.
|
|
|
1859 Returns true if comment is found."
|
|
|
1860 (let (state stop-in cpoint (lim (progn (end-of-line) (point))))
|
|
|
1861 (beginning-of-line)
|
|
|
1862 (if (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)
|
|
|
1863 (if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
|
|
|
1864 ;; Else
|
|
|
1865 (while (not stop-in)
|
|
|
1866 (setq state (parse-partial-sexp (point) lim nil nil nil t))
|
|
|
1867 ; stop at comment
|
|
|
1868 ;; If fails (beginning-of-line inside sexp), then contains not-comment
|
|
|
1869 ;; Do simplified processing
|
|
|
1870 ;;(if (re-search-forward "[^$]#" lim 1)
|
|
|
1871 ;; (progn
|
|
|
1872 ;; (forward-char -1)
|
|
|
1873 ;; (skip-chars-backward " \t\n\f" lim))
|
|
|
1874 ;; (goto-char lim)) ; No `#' at all
|
|
|
1875 ;;)
|
|
|
1876 (if (nth 4 state) ; After `#';
|
|
|
1877 ; (nth 2 state) can be
|
|
|
1878 ; beginning of m,s,qq and so
|
|
|
1879 ; on
|
|
|
1880 (if (nth 2 state)
|
|
|
1881 (progn
|
|
|
1882 (setq cpoint (point))
|
|
|
1883 (goto-char (nth 2 state))
|
|
|
1884 (cond
|
|
|
1885 ((looking-at "\\(s\\|tr\\)\\>")
|
|
|
1886 (or (re-search-forward
|
|
|
1887 "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*"
|
|
|
1888 lim 'move)
|
|
|
1889 (setq stop-in t)))
|
|
|
1890 ((looking-at "\\(m\\|q\\([qxw]\\)?\\)\\>")
|
|
|
1891 (or (re-search-forward
|
|
|
1892 "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#"
|
|
|
1893 lim 'move)
|
|
|
1894 (setq stop-in t)))
|
|
|
1895 (t ; It was fair comment
|
|
|
1896 (setq stop-in t) ; Finish
|
|
|
1897 (goto-char (1- cpoint)))))
|
|
|
1898 (setq stop-in t) ; Finish
|
|
|
1899 (forward-char -1))
|
|
|
1900 (setq stop-in t)) ; Finish
|
|
|
1901 )
|
|
|
1902 (nth 4 state))))
|
|
|
1903
|
|
|
1904 (defun cperl-find-pods-heres (&optional min max)
|
|
|
1905 "Scans the buffer for POD sections and here-documents.
|
|
|
1906 If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
|
|
|
1907 the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|
|
1908 `cperl-here-face'."
|
|
|
1909 (interactive)
|
|
|
1910 (or min (setq min (point-min)))
|
|
|
1911 (or max (setq max (point-max)))
|
|
|
1912 (let (face head-face here-face b e bb tag err
|
|
|
1913 (cperl-pod-here-fontify (eval cperl-pod-here-fontify))
|
|
|
1914 (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
|
|
|
1915 (modified (buffer-modified-p)))
|
|
|
1916 (unwind-protect
|
|
|
1917 (progn
|
|
|
1918 (save-excursion
|
|
|
1919 (message "Scanning for pods and here-docs...")
|
|
|
1920 (if cperl-pod-here-fontify
|
|
|
1921 (setq face (eval cperl-pod-face)
|
|
|
1922 head-face (eval cperl-pod-head-face)
|
|
|
1923 here-face (eval cperl-here-face)))
|
|
|
1924 (remove-text-properties min max '(syntax-type t))
|
|
|
1925 ;; Need to remove face as well...
|
|
|
1926 (goto-char min)
|
|
|
1927 (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
|
|
|
1928 (if (looking-at "\n*cut\\>")
|
|
|
1929 (progn
|
|
|
1930 (message "=cut is not preceeded by a pod section")
|
|
|
1931 (setq err (point)))
|
|
|
1932 (beginning-of-line)
|
|
|
1933 (setq b (point) bb b)
|
|
|
1934 (or (re-search-forward "\n\n=cut\\>" max 'toend)
|
|
|
1935 (message "Cannot find the end of a pod section"))
|
|
|
1936 (beginning-of-line 4)
|
|
|
1937 (setq e (point))
|
|
|
1938 (put-text-property b e 'in-pod t)
|
|
|
1939 (goto-char b)
|
|
|
1940 (while (re-search-forward "\n\n[ \t]" e t)
|
|
|
1941 (beginning-of-line)
|
|
|
1942 (put-text-property b (point) 'syntax-type 'pod)
|
|
|
1943 (put-text-property (max (point-min) (1- b))
|
|
|
1944 (point) cperl-do-not-fontify t)
|
|
|
1945 (if cperl-pod-here-fontify (put-text-property b (point) 'face face))
|
|
|
1946 (re-search-forward "\n\n[^ \t\f]" e 'toend)
|
|
|
1947 (beginning-of-line)
|
|
|
1948 (setq b (point)))
|
|
|
1949 (put-text-property (point) e 'syntax-type 'pod)
|
|
|
1950 (put-text-property (max (point-min) (1- (point)))
|
|
|
1951 e cperl-do-not-fontify t)
|
|
|
1952 (if cperl-pod-here-fontify
|
|
|
1953 (progn (put-text-property (point) e 'face face)
|
|
|
1954 (goto-char bb)
|
|
|
1955 (while (re-search-forward
|
|
|
1956 ;; One paragraph
|
|
|
1957 "\n\n=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
|
|
|
1958 e 'toend)
|
|
|
1959 (put-text-property
|
|
|
1960 (match-beginning 1) (match-end 1)
|
|
|
1961 'face head-face))))
|
|
|
1962 (goto-char e)))
|
|
|
1963 (goto-char min)
|
|
|
1964 (while (re-search-forward
|
|
|
1965 "<<\\(\\([\"'`]\\)?\\)\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\1"
|
|
|
1966 max t)
|
|
|
1967 (setq tag (buffer-substring (match-beginning 3)
|
|
|
1968 (match-end 3)))
|
|
|
1969 (if cperl-pod-here-fontify
|
|
|
1970 (put-text-property (match-beginning 3) (match-end 3)
|
|
|
1971 'face font-lock-reference-face))
|
|
|
1972 (forward-line)
|
|
|
1973 (setq b (point))
|
|
|
1974 (and (re-search-forward (concat "^" tag "$") max 'toend)
|
|
|
1975 (progn
|
|
|
1976 (if cperl-pod-here-fontify
|
|
|
1977 (progn
|
|
|
1978 (put-text-property (match-beginning 0) (match-end 0)
|
|
|
1979 'face font-lock-reference-face)
|
|
|
1980 (put-text-property (max (point-min) (1- b))
|
|
|
1981 (min (point-max)
|
|
|
1982 (1+ (match-end 0)))
|
|
|
1983 cperl-do-not-fontify t)
|
|
|
1984 (put-text-property b (match-beginning 0)
|
|
|
1985 'face here-face)))
|
|
|
1986 (put-text-property b (match-beginning 0)
|
|
|
1987 'syntax-type 'here-doc)))))
|
|
|
1988 (if err (goto-char err)
|
|
|
1989 (message "Scan for pods and here-docs completed.")))
|
|
|
1990 (and (buffer-modified-p)
|
|
|
1991 (not modified)
|
|
|
1992 (set-buffer-modified-p nil)))))
|
|
|
1993
|
|
|
1994 (defun cperl-backward-to-noncomment (lim)
|
|
|
1995 ;; Stops at lim or after non-whitespace that is not in comment
|
|
|
1996 (let (stop p)
|
|
|
1997 (while (and (not stop) (> (point) (or lim 1)))
|
|
|
1998 (skip-chars-backward " \t\n\f" lim)
|
|
|
1999 (setq p (point))
|
|
|
2000 (beginning-of-line)
|
|
|
2001 (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
|
|
|
2002 ;; Else
|
|
|
2003 (cperl-to-comment-or-eol)
|
|
|
2004 (skip-chars-backward " \t")
|
|
|
2005 (if (< p (point)) (goto-char p))
|
|
|
2006 (setq stop t)))))
|
|
|
2007
|
|
|
2008 (defun cperl-after-expr-p (&optional lim chars test)
|
|
|
2009 "Returns true if the position is good for start of expression.
|
|
|
2010 TEST is the expression to evaluate at the found position. If absent,
|
|
|
2011 CHARS is a string that contains good characters to have before us."
|
|
|
2012 (let (stop p)
|
|
|
2013 (save-excursion
|
|
|
2014 (while (and (not stop) (> (point) (or lim 1)))
|
|
|
2015 (skip-chars-backward " \t\n\f" lim)
|
|
|
2016 (setq p (point))
|
|
|
2017 (beginning-of-line)
|
|
|
2018 (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
|
|
|
2019 ;; Else: last iteration (What to do with labels?)
|
|
|
2020 (cperl-to-comment-or-eol)
|
|
|
2021 (skip-chars-backward " \t")
|
|
|
2022 (if (< p (point)) (goto-char p))
|
|
|
2023 (setq stop t)))
|
|
|
2024 (or (bobp)
|
|
|
2025 (progn
|
|
|
2026 (backward-char 1)
|
|
|
2027 (if test (eval test)
|
|
|
2028 (memq (following-char) (append (or chars "{};") nil))))))))
|
|
|
2029
|
|
|
2030 (defun cperl-backward-to-start-of-continued-exp (lim)
|
|
|
2031 (if (memq (preceding-char) (append ")]}\"'`" nil))
|
|
|
2032 (forward-sexp -1))
|
|
|
2033 (beginning-of-line)
|
|
|
2034 (if (<= (point) lim)
|
|
|
2035 (goto-char (1+ lim)))
|
|
|
2036 (skip-chars-forward " \t"))
|
|
|
2037
|
|
|
2038
|
|
|
2039 (defvar innerloop-done nil)
|
|
|
2040 (defvar last-depth nil)
|
|
|
2041
|
|
|
2042 (defun cperl-indent-exp ()
|
|
|
2043 "Simple variant of indentation of continued-sexp.
|
|
|
2044 Should be slow. Will not indent comment if it starts at `comment-indent'
|
|
|
2045 or looks like continuation of the comment on the previous line."
|
|
|
2046 (interactive)
|
|
|
2047 (save-excursion
|
|
|
2048 (let ((tmp-end (progn (end-of-line) (point))) top done)
|
|
|
2049 (save-excursion
|
|
|
2050 (while (null done)
|
|
|
2051 (beginning-of-line)
|
|
|
2052 (setq top (point))
|
|
|
2053 (while (= (nth 0 (parse-partial-sexp (point) tmp-end
|
|
|
2054 -1)) -1)
|
|
|
2055 (setq top (point))) ; Get the outermost parenths in line
|
|
|
2056 (goto-char top)
|
|
|
2057 (while (< (point) tmp-end)
|
|
|
2058 (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
|
|
|
2059 (or (eolp) (forward-sexp 1)))
|
|
|
2060 (if (> (point) tmp-end) (progn (end-of-line) (setq tmp-end (point)))
|
|
|
2061 (setq done t)))
|
|
|
2062 (goto-char tmp-end)
|
|
|
2063 (setq tmp-end (point-marker)))
|
|
|
2064 (cperl-indent-region (point) tmp-end))))
|
|
|
2065
|
|
|
2066 (defun cperl-indent-region (start end)
|
|
|
2067 "Simple variant of indentation of region in CPerl mode.
|
|
|
2068 Should be slow. Will not indent comment if it starts at `comment-indent'
|
|
|
2069 or looks like continuation of the comment on the previous line.
|
|
|
2070 Indents all the lines whose first character is between START and END
|
|
|
2071 inclusive."
|
|
|
2072 (interactive "r")
|
|
|
2073 (save-excursion
|
|
|
2074 (let (st comm indent-info old-comm-indent new-comm-indent
|
|
|
2075 (pm 0) (imenu-scanning-message "Indenting... (%3d%%)"))
|
|
|
2076 (goto-char start)
|
|
|
2077 (setq old-comm-indent (and (cperl-to-comment-or-eol)
|
|
|
2078 (current-column))
|
|
|
2079 new-comm-indent old-comm-indent)
|
|
|
2080 (goto-char start)
|
|
|
2081 (or (bolp) (beginning-of-line 2))
|
|
|
2082 (or (fboundp 'imenu-progress-message)
|
|
|
2083 (message "Indenting... For feedback load `imenu'..."))
|
|
|
2084 (while (and (<= (point) end) (not (eobp))) ; bol to check start
|
|
|
2085 (and (fboundp 'imenu-progress-message)
|
|
|
2086 (imenu-progress-message
|
|
|
2087 pm (/ (* 100 (- (point) start)) (- end start -1))))
|
|
|
2088 (setq st (point)
|
|
|
2089 indent-info nil
|
|
|
2090 ) ; Believe indentation of the current
|
|
|
2091 (if (and (setq comm (looking-at "[ \t]*#"))
|
|
|
2092 (or (eq (current-indentation) (or old-comm-indent
|
|
|
2093 comment-column))
|
|
|
2094 (setq old-comm-indent nil)))
|
|
|
2095 (if (and old-comm-indent
|
|
|
2096 (= (current-indentation) old-comm-indent))
|
|
|
2097 (let ((comment-column new-comm-indent))
|
|
|
2098 (indent-for-comment)))
|
|
|
2099 (progn
|
|
|
2100 (cperl-indent-line 'indent-info)
|
|
|
2101 (or comm
|
|
|
2102 (progn
|
|
|
2103 (if (setq old-comm-indent (and (cperl-to-comment-or-eol)
|
|
|
2104 (current-column)))
|
|
|
2105 (progn (indent-for-comment)
|
|
|
2106 (skip-chars-backward " \t")
|
|
|
2107 (skip-chars-backward "#")
|
|
|
2108 (setq new-comm-indent (current-column))))))))
|
|
|
2109 (beginning-of-line 2))
|
|
|
2110 (if (fboundp 'imenu-progress-message)
|
|
|
2111 (imenu-progress-message pm 100)
|
|
|
2112 (message nil)))))
|
|
|
2113
|
|
|
2114 (defun cperl-slash-is-regexp (&optional pos)
|
|
|
2115 (save-excursion
|
|
|
2116 (goto-char (if pos pos (1- (point))))
|
|
|
2117 (and
|
|
|
2118 (not (memq (get-text-property (point) 'face)
|
|
|
2119 '(font-lock-string-face font-lock-comment-face)))
|
|
|
2120 (cperl-after-expr-p nil nil '
|
|
|
2121 (or (looking-at "[^]a-zA-Z0-9_)}]")
|
|
|
2122 (eq (get-text-property (point) 'face)
|
|
|
2123 'font-lock-keyword-face))))))
|
|
|
2124
|
|
|
2125 ;; Stolen from lisp-mode with a lot of improvements
|
|
|
2126
|
|
|
2127 (defun cperl-fill-paragraph (&optional justify iteration)
|
|
|
2128 "Like \\[fill-paragraph], but handle CPerl comments.
|
|
|
2129 If any of the current line is a comment, fill the comment or the
|
|
|
2130 block of it that point is in, preserving the comment's initial
|
|
|
2131 indentation and initial hashes. Behaves usually outside of comment."
|
|
|
2132 (interactive "P")
|
|
|
2133 (let (
|
|
|
2134 ;; Non-nil if the current line contains a comment.
|
|
|
2135 has-comment
|
|
|
2136
|
|
|
2137 ;; If has-comment, the appropriate fill-prefix for the comment.
|
|
|
2138 comment-fill-prefix
|
|
|
2139 ;; Line that contains code and comment (or nil)
|
|
|
2140 start
|
|
|
2141 c spaces len dc (comment-column comment-column))
|
|
|
2142 ;; Figure out what kind of comment we are looking at.
|
|
|
2143 (save-excursion
|
|
|
2144 (beginning-of-line)
|
|
|
2145 (cond
|
|
|
2146
|
|
|
2147 ;; A line with nothing but a comment on it?
|
|
|
2148 ((looking-at "[ \t]*#[# \t]*")
|
|
|
2149 (setq has-comment t
|
|
|
2150 comment-fill-prefix (buffer-substring (match-beginning 0)
|
|
|
2151 (match-end 0))))
|
|
|
2152
|
|
|
2153 ;; A line with some code, followed by a comment? Remember that the
|
|
|
2154 ;; semi which starts the comment shouldn't be part of a string or
|
|
|
2155 ;; character.
|
|
|
2156 ((cperl-to-comment-or-eol)
|
|
|
2157 (setq has-comment t)
|
|
|
2158 (looking-at "#+[ \t]*")
|
|
|
2159 (setq start (point) c (current-column)
|
|
|
2160 comment-fill-prefix
|
|
|
2161 (concat (make-string (current-column) ?\ )
|
|
|
2162 (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
2163 spaces (progn (skip-chars-backward " \t")
|
|
|
2164 (buffer-substring (point) start))
|
|
|
2165 dc (- c (current-column)) len (- start (point))
|
|
|
2166 start (point-marker))
|
|
|
2167 (delete-char len)
|
|
|
2168 (insert (make-string dc ?-)))))
|
|
|
2169 (if (not has-comment)
|
|
|
2170 (fill-paragraph justify) ; Do the usual thing outside of comment
|
|
|
2171 ;; Narrow to include only the comment, and then fill the region.
|
|
|
2172 (save-restriction
|
|
|
2173 (narrow-to-region
|
|
|
2174 ;; Find the first line we should include in the region to fill.
|
|
|
2175 (if start (progn (beginning-of-line) (point))
|
|
|
2176 (save-excursion
|
|
|
2177 (while (and (zerop (forward-line -1))
|
|
|
2178 (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
|
|
|
2179 ;; We may have gone to far. Go forward again.
|
|
|
2180 (or (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")
|
|
|
2181 (forward-line 1))
|
|
|
2182 (point)))
|
|
|
2183 ;; Find the beginning of the first line past the region to fill.
|
|
|
2184 (save-excursion
|
|
|
2185 (while (progn (forward-line 1)
|
|
|
2186 (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
|
|
|
2187 (point)))
|
|
|
2188 ;; Remove existing hashes
|
|
|
2189 (goto-char (point-min))
|
|
|
2190 (while (progn (forward-line 1) (< (point) (point-max)))
|
|
|
2191 (skip-chars-forward " \t")
|
|
|
2192 (and (looking-at "#+")
|
|
|
2193 (delete-char (- (match-end 0) (match-beginning 0)))))
|
|
|
2194
|
|
|
2195 ;; Lines with only hashes on them can be paragraph boundaries.
|
|
|
2196 (let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$"))
|
|
|
2197 (paragraph-separate (concat paragraph-start "\\|^[ \t#]*$"))
|
|
|
2198 (fill-prefix comment-fill-prefix))
|
|
|
2199 (fill-paragraph justify)))
|
|
|
2200 (if (and start)
|
|
|
2201 (progn
|
|
|
2202 (goto-char start)
|
|
|
2203 (if (> dc 0)
|
|
|
2204 (progn (delete-char dc) (insert spaces)))
|
|
|
2205 (if (or (= (current-column) c) iteration) nil
|
|
|
2206 (setq comment-column c)
|
|
|
2207 (indent-for-comment)
|
|
|
2208 ;; Repeat once more, flagging as iteration
|
|
|
2209 (cperl-fill-paragraph justify t)))))))
|
|
|
2210
|
|
|
2211 (defun cperl-do-auto-fill ()
|
|
|
2212 ;; Break out if the line is short enough
|
|
|
2213 (if (> (save-excursion
|
|
|
2214 (end-of-line)
|
|
|
2215 (current-column))
|
|
|
2216 fill-column)
|
|
|
2217 (let ((c (save-excursion (beginning-of-line)
|
|
|
2218 (cperl-to-comment-or-eol) (point)))
|
|
|
2219 (s (memq (following-char) '(?\ ?\t))) marker)
|
|
|
2220 (if (>= c (point)) nil
|
|
|
2221 (setq marker (point-marker))
|
|
|
2222 (cperl-fill-paragraph)
|
|
|
2223 (goto-char marker)
|
|
|
2224 ;; Is not enough, sometimes marker is a start of line
|
|
|
2225 (if (bolp) (progn (re-search-forward "#+[ \t]*")
|
|
|
2226 (goto-char (match-end 0))))
|
|
|
2227 ;; Following space could have gone:
|
|
|
2228 (if (or (not s) (memq (following-char) '(?\ ?\t))) nil
|
|
|
2229 (insert " ")
|
|
|
2230 (backward-char 1))
|
|
|
2231 ;; Previous space could have gone:
|
|
|
2232 (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
|
|
|
2233
|
|
|
2234 (defvar imenu-example--function-name-regexp-perl
|
|
|
2235 "^\\([ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\|=head\\([12]\\)[ \t]+\\([^\n]+\\)$\\)")
|
|
|
2236
|
|
|
2237 (defun imenu-example--create-perl-index (&optional regexp)
|
|
|
2238 (require 'cl)
|
|
|
2239 (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
|
|
|
2240 (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
|
|
|
2241 packages ends-ranges p
|
|
|
2242 (prev-pos 0) char fchar index index1 name (end-range 0) package)
|
|
|
2243 (goto-char (point-min))
|
|
|
2244 (imenu-progress-message prev-pos 0)
|
|
|
2245 ;; Search for the function
|
|
|
2246 (save-match-data
|
|
|
2247 (while (re-search-forward
|
|
|
2248 (or regexp imenu-example--function-name-regexp-perl)
|
|
|
2249 nil t)
|
|
|
2250 (imenu-progress-message prev-pos)
|
|
|
2251 ;;(backward-up-list 1)
|
|
|
2252 (cond
|
|
|
2253 ((match-beginning 2) ; package or sub
|
|
|
2254 (save-excursion
|
|
|
2255 (goto-char (match-beginning 2))
|
|
|
2256 (setq fchar (following-char))
|
|
|
2257 )
|
|
|
2258 (setq char (following-char))
|
|
|
2259 (setq p (point))
|
|
|
2260 (while (and ends-ranges (>= p (car ends-ranges)))
|
|
|
2261 ;; delete obsolete entries
|
|
|
2262 (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
|
|
|
2263 (setq package (or (car packages) "")
|
|
|
2264 end-range (or (car ends-ranges) 0))
|
|
|
2265 (if (eq fchar ?p)
|
|
|
2266 (progn
|
|
|
2267 (setq name (buffer-substring (match-beginning 3) (match-end 3))
|
|
|
2268 package (concat name "::")
|
|
|
2269 name (concat "package " name)
|
|
|
2270 end-range
|
|
|
2271 (save-excursion
|
|
|
2272 (parse-partial-sexp (point) (point-max) -1) (point))
|
|
|
2273 ends-ranges (cons end-range ends-ranges)
|
|
|
2274 packages (cons package packages))))
|
|
|
2275 ;; )
|
|
|
2276 ;; Skip this function name if it is a prototype declaration.
|
|
|
2277 (if (and (eq fchar ?s) (eq char ?\;)) nil
|
|
|
2278 (if (eq fchar ?p) nil
|
|
|
2279 (setq name (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
2280 (if (or (> p end-range) (string-match "[:']" name)) nil
|
|
|
2281 (setq name (concat package name))))
|
|
|
2282 (setq index (imenu-example--name-and-position))
|
|
|
2283 (setcar index name)
|
|
|
2284 (if (eq fchar ?p)
|
|
|
2285 (push index index-pack-alist)
|
|
|
2286 (push index index-alist))
|
|
|
2287 (push index index-unsorted-alist)))
|
|
|
2288 (t ; Pod section
|
|
|
2289 ;; (beginning-of-line)
|
|
|
2290 (setq index (imenu-example--name-and-position)
|
|
|
2291 name (buffer-substring (match-beginning 5) (match-end 5)))
|
|
|
2292 (if (eq (char-after (match-beginning 4)) ?2)
|
|
|
2293 (setq name (concat " " name)))
|
|
|
2294 (setcar index name)
|
|
|
2295 (setq index1 (cons (concat "=" name) (cdr index)))
|
|
|
2296 (push index index-pod-alist)
|
|
|
2297 (push index1 index-unsorted-alist)))))
|
|
|
2298 (imenu-progress-message prev-pos 100)
|
|
|
2299 (setq index-alist
|
|
|
2300 (if (default-value 'imenu-sort-function)
|
|
|
2301 (sort index-alist (default-value 'imenu-sort-function))
|
|
|
2302 (nreverse index-alist)))
|
|
|
2303 (and index-pod-alist
|
|
|
2304 (push (cons (imenu-create-submenu-name "+POD headers+")
|
|
|
2305 (nreverse index-pod-alist))
|
|
|
2306 index-alist))
|
|
|
2307 (and index-pack-alist
|
|
|
2308 (push (cons (imenu-create-submenu-name "+Packages+")
|
|
|
2309 (nreverse index-pack-alist))
|
|
|
2310 index-alist))
|
|
|
2311 (and (or index-pack-alist index-pod-alist
|
|
|
2312 (default-value 'imenu-sort-function))
|
|
|
2313 index-unsorted-alist
|
|
|
2314 (push (cons (imenu-create-submenu-name "+Unsorted List+")
|
|
|
2315 (nreverse index-unsorted-alist))
|
|
|
2316 index-alist))
|
|
|
2317 index-alist))
|
|
|
2318
|
|
|
2319 (defvar cperl-compilation-error-regexp-alist
|
|
|
2320 ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK).
|
|
|
2321 '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
|
|
|
2322 2 3))
|
|
|
2323 "Alist that specifies how to match errors in perl output.")
|
|
|
2324
|
|
|
2325 (if (fboundp 'eval-after-load)
|
|
|
2326 (eval-after-load
|
|
|
2327 "mode-compile"
|
|
|
2328 '(setq perl-compilation-error-regexp-alist
|
|
|
2329 cperl-compilation-error-regexp-alist)))
|
|
|
2330
|
|
|
2331
|
|
|
2332 (defvar cperl-faces-init nil)
|
|
|
2333
|
|
|
2334 (defun cperl-windowed-init ()
|
|
|
2335 "Initialization under windowed version."
|
|
|
2336 (add-hook 'font-lock-mode-hook
|
|
|
2337 (function
|
|
|
2338 (lambda ()
|
|
|
2339 (if (or
|
|
|
2340 (eq major-mode 'perl-mode)
|
|
|
2341 (eq major-mode 'cperl-mode))
|
|
|
2342 (progn
|
|
|
2343 (or cperl-faces-init (cperl-init-faces))))))))
|
|
|
2344
|
|
|
2345 (defvar perl-font-lock-keywords-1 nil
|
|
|
2346 "Additional expressions to highlight in Perl mode. Minimal set.")
|
|
|
2347 (defvar perl-font-lock-keywords nil
|
|
|
2348 "Additional expressions to highlight in Perl mode. Default set.")
|
|
|
2349 (defvar perl-font-lock-keywords-2 nil
|
|
|
2350 "Additional expressions to highlight in Perl mode. Maximal set")
|
|
|
2351
|
|
|
2352 (defun cperl-init-faces ()
|
|
|
2353 (condition-case nil
|
|
|
2354 (progn
|
|
|
2355 (require 'font-lock)
|
|
|
2356 (and (fboundp 'font-lock-fontify-anchored-keywords)
|
|
|
2357 (featurep 'font-lock-extra)
|
|
|
2358 (message "You have an obsolete package `font-lock-extra'. Install `choose-color'."))
|
|
|
2359 (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
|
|
|
2360 ;;(defvar cperl-font-lock-enhanced nil
|
|
|
2361 ;; "Set to be non-nil if font-lock allows active highlights.")
|
|
|
2362 (if (fboundp 'font-lock-fontify-anchored-keywords)
|
|
|
2363 (setq font-lock-anchored t))
|
|
|
2364 (setq
|
|
|
2365 t-font-lock-keywords
|
|
|
2366 (list
|
|
|
2367 (cons
|
|
|
2368 (concat
|
|
|
2369 "\\(^\\|[^$@%&\\]\\)\\<\\("
|
|
|
2370 (mapconcat
|
|
|
2371 'identity
|
|
|
2372 '("if" "until" "while" "elsif" "else" "unless" "for"
|
|
|
2373 "foreach" "continue" "exit" "die" "last" "goto" "next"
|
|
|
2374 "redo" "return" "local" "exec" "sub" "do" "dump" "use"
|
|
|
2375 "require" "package" "eval" "my" "BEGIN" "END")
|
|
|
2376 "\\|") ; Flow control
|
|
|
2377 "\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]"
|
|
|
2378 ; In what follows we use `type' style
|
|
|
2379 ; for overwritable buildins
|
|
|
2380 (list
|
|
|
2381 (concat
|
|
|
2382 "\\(^\\|[^$@%&\\]\\)\\<\\("
|
|
|
2383 ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2"
|
|
|
2384 ;; "bind" "binmode" "bless" "caller" "chdir" "chmod" "chown" "chr"
|
|
|
2385 ;; "chroot" "close" "closedir" "cmp" "connect" "continue" "cos"
|
|
|
2386 ;; "crypt" "dbmclose" "dbmopen" "die" "dump" "endgrent" "endhostent"
|
|
|
2387 ;; "endnetent" "endprotoent" "endpwent" "endservent" "eof" "eq" "exec"
|
|
|
2388 ;; "exit" "exp" "fcntl" "fileno" "flock" "fork" "formline" "ge" "getc"
|
|
|
2389 ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" "gethostbyname"
|
|
|
2390 ;; "gethostent" "getlogin" "getnetbyaddr" "getnetbyname" "getnetent"
|
|
|
2391 ;; "getpeername" "getpgrp" "getppid" "getpriority" "getprotobyname"
|
|
|
2392 ;; "getprotobynumber" "getprotoent" "getpwent" "getpwnam" "getpwuid"
|
|
|
2393 ;; "getservbyname" "getservbyport" "getservent" "getsockname"
|
|
|
2394 ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" "ioctl"
|
|
|
2395 ;; "join" "kill" "lc" "lcfirst" "le" "length" "link" "listen"
|
|
|
2396 ;; "localtime" "log" "lstat" "lt" "mkdir" "msgctl" "msgget" "msgrcv"
|
|
|
2397 ;; "msgsnd" "ne" "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
|
|
|
2398 ;; "quotemeta" "rand" "read" "readdir" "readline" "readlink"
|
|
|
2399 ;; "readpipe" "recv" "ref" "rename" "require" "reset" "reverse"
|
|
|
2400 ;; "rewinddir" "rindex" "rmdir" "seek" "seekdir" "select" "semctl"
|
|
|
2401 ;; "semget" "semop" "send" "setgrent" "sethostent" "setnetent"
|
|
|
2402 ;; "setpgrp" "setpriority" "setprotoent" "setpwent" "setservent"
|
|
|
2403 ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" "shutdown"
|
|
|
2404 ;; "sin" "sleep" "socket" "socketpair" "sprintf" "sqrt" "srand" "stat"
|
|
|
2405 ;; "substr" "symlink" "syscall" "sysread" "system" "syswrite" "tell"
|
|
|
2406 ;; "telldir" "time" "times" "truncate" "uc" "ucfirst" "umask" "unlink"
|
|
|
2407 ;; "unpack" "utime" "values" "vec" "wait" "waitpid" "wantarray" "warn"
|
|
|
2408 ;; "write" "x" "xor"
|
|
|
2409 "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|"
|
|
|
2410 "b\\(in\\(d\\|mode\\)\\|less\\)\\|"
|
|
|
2411 "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
|
|
|
2412 "lose\\(\\|dir\\)\\|mp\\|o\\(s\\|n\\(tinue\\|nect\\)\\)\\)\\|"
|
|
|
2413 "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|"
|
|
|
2414 "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|"
|
|
|
2415 "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|"
|
|
|
2416 "f\\(ileno\\|cntl\\|lock\\|or\\(k\\|mline\\)\\)\\|"
|
|
|
2417 "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|"
|
|
|
2418 "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w"
|
|
|
2419 "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|"
|
|
|
2420 "ent\\)\\|s\\(erv\\(by\\(port\\|name\\)\\|ent\\)\\|"
|
|
|
2421 "ock\\(name\\|opt\\)\\)\\|c\\|login\\|net\\(by\\(addr\\|name\\)\\|"
|
|
|
2422 "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|"
|
|
|
2423 "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|"
|
|
|
2424 "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e"
|
|
|
2425 "\\(\\|ngth\\)\\|o\\(caltime\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
|
|
|
2426 "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|"
|
|
|
2427 "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|"
|
|
|
2428 "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin"
|
|
|
2429 "\\(k\\|e\\)\\|dir\\)\\|set\\|cv\\|verse\\|f\\|winddir\\|name"
|
|
|
2430 "\\)\\)\\|s\\(printf\\|qrt\\|rand\\|tat\\|ubstr\\|e\\(t\\(p\\(r"
|
|
|
2431 "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|"
|
|
|
2432 "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|"
|
|
|
2433 "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|"
|
|
|
2434 "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|tem\\|write\\)\\|"
|
|
|
2435 "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|"
|
|
|
2436 "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
|
|
|
2437 "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
|
|
|
2438 "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
|
|
|
2439 "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\)"
|
|
|
2440 "\\)\\>") 2 'font-lock-type-face)
|
|
|
2441 ;; In what follows we use `other' style
|
|
|
2442 ;; for nonoverwritable buildins
|
|
|
2443 ;; Somehow 's', 'm' are not autogenerated???
|
|
|
2444 (list
|
|
|
2445 (concat
|
|
|
2446 "\\(^\\|[^$@%&\\]\\)\\<\\("
|
|
|
2447 ;; "AUTOLOAD" "BEGIN" "DESTROY" "END" "__END__" "chomp" "chop"
|
|
|
2448 ;; "defined" "delete" "do" "each" "else" "elsif" "eval" "exists" "for"
|
|
|
2449 ;; "foreach" "format" "goto" "grep" "if" "keys" "last" "local" "map"
|
|
|
2450 ;; "my" "next" "no" "package" "pop" "pos" "print" "printf" "push" "q"
|
|
|
2451 ;; "qq" "qw" "qx" "redo" "return" "scalar" "shift" "sort" "splice"
|
|
|
2452 ;; "split" "study" "sub" "tie" "tr" "undef" "unless" "unshift" "untie"
|
|
|
2453 ;; "until" "use" "while" "y"
|
|
|
2454 "AUTOLOAD\\|BEGIN\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
|
|
|
2455 "o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
|
|
|
2456 "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|"
|
|
|
2457 "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|"
|
|
|
2458 "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
|
|
|
2459 "q\\(\\|q\\|w\\|x\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|"
|
|
|
2460 "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|"
|
|
|
2461 "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
|
|
|
2462 "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
|
|
|
2463 "\\|[sm]" ; Added manually
|
|
|
2464 "\\)\\>") 2 'font-lock-other-type-face)
|
|
|
2465 ;; (mapconcat 'identity
|
|
|
2466 ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
|
|
|
2467 ;; "#include" "#define" "#undef")
|
|
|
2468 ;; "\\|")
|
|
|
2469 '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
|
|
|
2470 font-lock-function-name-face) ; Not very good, triggers at "[a-z]"
|
|
|
2471 '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*[{\n]" 1
|
|
|
2472 font-lock-function-name-face)
|
|
|
2473 '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
|
|
|
2474 2 font-lock-function-name-face)
|
|
|
2475 (cond ((featurep 'font-lock-extra)
|
|
|
2476 '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
|
|
|
2477 (2 font-lock-string-face t)
|
|
|
2478 (0 '(restart 2 t)))) ; To highlight $a{bc}{ef}
|
|
|
2479 (font-lock-anchored
|
|
|
2480 '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
|
|
|
2481 (2 font-lock-string-face t)
|
|
|
2482 ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
|
|
|
2483 nil nil
|
|
|
2484 (1 font-lock-string-face t))))
|
|
|
2485 (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
|
|
|
2486 2 font-lock-string-face t)))
|
|
|
2487 '("[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
|
|
|
2488 font-lock-string-face t)
|
|
|
2489 '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
|
|
|
2490 font-lock-reference-face) ; labels
|
|
|
2491 '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
|
|
|
2492 2 font-lock-reference-face)
|
|
|
2493 (cond ((featurep 'font-lock-extra)
|
|
|
2494 '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
|
|
|
2495 (3 font-lock-variable-name-face)
|
|
|
2496 (4 '(another 4 nil
|
|
|
2497 ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
|
|
|
2498 (1 font-lock-variable-name-face)
|
|
|
2499 (2 '(restart 2 nil) nil t)))
|
|
|
2500 nil t))) ; local variables, multiple
|
|
|
2501 (font-lock-anchored
|
|
|
2502 '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
|
|
|
2503 (3 font-lock-variable-name-face)
|
|
|
2504 ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)"
|
|
|
2505 nil nil
|
|
|
2506 (1 font-lock-variable-name-face))))
|
|
|
2507 (t '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
|
|
|
2508 3 font-lock-variable-name-face)))
|
|
|
2509 '("\\<for\\(each\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
|
|
|
2510 2 font-lock-variable-name-face)))
|
|
|
2511 (setq
|
|
|
2512 t-font-lock-keywords-1
|
|
|
2513 (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
|
|
|
2514 (not (cperl-xemacs-p)) ; not yet as of XEmacs 19.12
|
|
|
2515 '(("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
|
|
|
2516 1
|
|
|
2517 (if (= (- (match-end 2) (match-beginning 2)) 1)
|
|
|
2518 (if (eq (char-after (match-beginning 3)) ?{)
|
|
|
2519 font-lock-other-emphasized-face
|
|
|
2520 font-lock-emphasized-face) ; arrays and hashes
|
|
|
2521 font-lock-variable-name-face) ; Just to put something
|
|
|
2522 t)
|
|
|
2523 ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
|
|
|
2524 (if (eq (char-after (match-beginning 2)) ?%)
|
|
|
2525 font-lock-other-emphasized-face
|
|
|
2526 font-lock-emphasized-face)
|
|
|
2527 t) ; arrays and hashes
|
|
|
2528 ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
|
|
|
2529 ;;; Too much noise from \s* @s[ and friends
|
|
|
2530 ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)"
|
|
|
2531 ;;(3 font-lock-function-name-face t t)
|
|
|
2532 ;;(4
|
|
|
2533 ;; (if (cperl-slash-is-regexp)
|
|
|
2534 ;; font-lock-function-name-face 'default) nil t))
|
|
|
2535 )))
|
|
|
2536 (setq perl-font-lock-keywords-1 t-font-lock-keywords
|
|
|
2537 perl-font-lock-keywords perl-font-lock-keywords-1
|
|
|
2538 perl-font-lock-keywords-2 (append
|
|
|
2539 t-font-lock-keywords
|
|
|
2540 t-font-lock-keywords-1)))
|
|
|
2541 (if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
|
|
|
2542 (if (or (featurep 'choose-color) (featurep 'font-lock-extra))
|
|
|
2543 (font-lock-require-faces
|
|
|
2544 (list
|
|
|
2545 ;; Color-light Color-dark Gray-light Gray-dark Mono
|
|
|
2546 (list 'font-lock-comment-face
|
|
|
2547 ["Firebrick" "OrangeRed" "DimGray" "Gray80"]
|
|
|
2548 nil
|
|
|
2549 [nil nil t t t]
|
|
|
2550 [nil nil t t t]
|
|
|
2551 nil)
|
|
|
2552 (list 'font-lock-string-face
|
|
|
2553 ["RosyBrown" "LightSalmon" "Gray50" "LightGray"]
|
|
|
2554 nil
|
|
|
2555 nil
|
|
|
2556 [nil nil t t t]
|
|
|
2557 nil)
|
|
|
2558 (list 'font-lock-keyword-face
|
|
|
2559 ["Purple" "LightSteelBlue" "DimGray" "Gray90"]
|
|
|
2560 nil
|
|
|
2561 [nil nil t t t]
|
|
|
2562 nil
|
|
|
2563 nil)
|
|
|
2564 (list 'font-lock-function-name-face
|
|
|
2565 (vector
|
|
|
2566 "Blue" "LightSkyBlue" "Gray50" "LightGray"
|
|
|
2567 (cdr (assq 'background-color ; if mono
|
|
|
2568 (frame-parameters))))
|
|
|
2569 (vector
|
|
|
2570 nil nil nil nil
|
|
|
2571 (cdr (assq 'foreground-color ; if mono
|
|
|
2572 (frame-parameters))))
|
|
|
2573 [nil nil t t t]
|
|
|
2574 nil
|
|
|
2575 nil)
|
|
|
2576 (list 'font-lock-variable-name-face
|
|
|
2577 ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"]
|
|
|
2578 nil
|
|
|
2579 [nil nil t t t]
|
|
|
2580 [nil nil t t t]
|
|
|
2581 nil)
|
|
|
2582 (list 'font-lock-type-face
|
|
|
2583 ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"]
|
|
|
2584 nil
|
|
|
2585 [nil nil t t t]
|
|
|
2586 nil
|
|
|
2587 [nil nil t t t]
|
|
|
2588 )
|
|
|
2589 (list 'font-lock-reference-face
|
|
|
2590 ["CadetBlue" "Aquamarine" "Gray50" "LightGray"]
|
|
|
2591 nil
|
|
|
2592 [nil nil t t t]
|
|
|
2593 nil
|
|
|
2594 [nil nil t t t]
|
|
|
2595 )
|
|
|
2596 (list 'font-lock-other-type-face
|
|
|
2597 ["chartreuse3" ("orchid1" "orange")
|
|
|
2598 nil "Gray80"]
|
|
|
2599 [nil nil "gray90"]
|
|
|
2600 [nil nil nil t t]
|
|
|
2601 [nil nil t t]
|
|
|
2602 [nil nil t t t]
|
|
|
2603 )
|
|
|
2604 (list 'font-lock-emphasized-face
|
|
|
2605 ["blue" "yellow" nil "Gray80"]
|
|
|
2606 ["lightyellow2" ("navy" "os2blue" "darkgreen")
|
|
|
2607 "gray90"]
|
|
|
2608 t
|
|
|
2609 nil
|
|
|
2610 nil)
|
|
|
2611 (list 'font-lock-other-emphasized-face
|
|
|
2612 ["red" "red" nil "Gray80"]
|
|
|
2613 ["lightyellow2" ("navy" "os2blue" "darkgreen")
|
|
|
2614 "gray90"]
|
|
|
2615 t
|
|
|
2616 t
|
|
|
2617 nil)))
|
|
|
2618 (defvar cperl-guessed-background nil
|
|
|
2619 "Display characteristics as guessed by cperl.")
|
|
|
2620 (or (fboundp 'x-color-defined-p)
|
|
|
2621 (defalias 'x-color-defined-p
|
|
|
2622 (cond ((fboundp 'color-defined-p) 'color-defined-p)
|
|
|
2623 ;; XEmacs >= 19.12
|
|
|
2624 ((fboundp 'valid-color-name-p) 'valid-color-name-p)
|
|
|
2625 ;; XEmacs 19.11
|
|
|
2626 (t 'x-valid-color-name-p))))
|
|
|
2627 (defvar font-lock-reference-face 'font-lock-reference-face)
|
|
|
2628 (defvar font-lock-variable-name-face 'font-lock-variable-name-face)
|
|
|
2629 (or (boundp 'font-lock-type-face)
|
|
|
2630 (defconst font-lock-type-face
|
|
|
2631 'font-lock-type-face
|
|
|
2632 "Face to use for data types.")
|
|
|
2633 )
|
|
|
2634 (or (boundp 'font-lock-other-type-face)
|
|
|
2635 (defconst font-lock-other-type-face
|
|
|
2636 'font-lock-other-type-face
|
|
|
2637 "Face to use for data types from another group.")
|
|
|
2638 )
|
|
|
2639 (if (not (cperl-xemacs-p)) nil
|
|
|
2640 (or (boundp 'font-lock-comment-face)
|
|
|
2641 (defconst font-lock-comment-face
|
|
|
2642 'font-lock-comment-face
|
|
|
2643 "Face to use for comments.")
|
|
|
2644 )
|
|
|
2645 (or (boundp 'font-lock-keyword-face)
|
|
|
2646 (defconst font-lock-keyword-face
|
|
|
2647 'font-lock-keyword-face
|
|
|
2648 "Face to use for keywords.")
|
|
|
2649 )
|
|
|
2650 (or (boundp 'font-lock-function-name-face)
|
|
|
2651 (defconst font-lock-function-name-face
|
|
|
2652 'font-lock-function-name-face
|
|
|
2653 "Face to use for function names.")
|
|
|
2654 )
|
|
|
2655 )
|
|
|
2656 ;;(if (featurep 'font-lock)
|
|
|
2657 (if (face-equal font-lock-type-face font-lock-comment-face)
|
|
|
2658 (defconst font-lock-type-face
|
|
|
2659 'font-lock-type-face
|
|
|
2660 "Face to use for basic data types.")
|
|
|
2661 )
|
|
|
2662 ;;; (if (fboundp 'eval-after-load)
|
|
|
2663 ;;; (eval-after-load "font-lock"
|
|
|
2664 ;;; '(if (face-equal font-lock-type-face
|
|
|
2665 ;;; font-lock-comment-face)
|
|
|
2666 ;;; (defconst font-lock-type-face
|
|
|
2667 ;;; 'font-lock-type-face
|
|
|
2668 ;;; "Face to use for basic data types.")
|
|
|
2669 ;;; ))) ; This does not work :-( Why?!
|
|
|
2670 ;;; ; Workaround: added to font-lock-m-h
|
|
|
2671 ;;; )
|
|
|
2672 (or (boundp 'font-lock-other-emphasized-face)
|
|
|
2673 (defconst font-lock-other-emphasized-face
|
|
|
2674 'font-lock-other-emphasized-face
|
|
|
2675 "Face to use for another type of emphasizing.")
|
|
|
2676 )
|
|
|
2677 (or (boundp 'font-lock-emphasized-face)
|
|
|
2678 (defconst font-lock-emphasized-face
|
|
|
2679 'font-lock-emphasized-face
|
|
|
2680 "Face to use for emphasizing.")
|
|
|
2681 )
|
|
|
2682 ;; Here we try to guess background
|
|
|
2683 (let ((background
|
|
|
2684 (if (boundp 'font-lock-background-mode)
|
|
|
2685 font-lock-background-mode
|
|
|
2686 'light))
|
|
|
2687 (face-list (and (fboundp 'face-list) (face-list)))
|
|
|
2688 is-face)
|
|
|
2689 (fset 'is-face
|
|
|
2690 (cond ((fboundp 'find-face)
|
|
|
2691 (symbol-function 'find-face))
|
|
|
2692 (face-list
|
|
|
2693 (function (lambda (face) (member face face-list))))
|
|
|
2694 (t
|
|
|
2695 (function (lambda (face) (boundp face))))))
|
|
|
2696 (defvar cperl-guessed-background
|
|
|
2697 (if (and (boundp 'font-lock-display-type)
|
|
|
2698 (eq font-lock-display-type 'grayscale))
|
|
|
2699 'gray
|
|
|
2700 background)
|
|
|
2701 "Background as guessed by CPerl mode")
|
|
|
2702 (if (is-face 'font-lock-type-face) nil
|
|
|
2703 (copy-face 'default 'font-lock-type-face)
|
|
|
2704 (cond
|
|
|
2705 ((eq background 'light)
|
|
|
2706 (set-face-foreground 'font-lock-type-face
|
|
|
2707 (if (x-color-defined-p "seagreen")
|
|
|
2708 "seagreen"
|
|
|
2709 "sea green")))
|
|
|
2710 ((eq background 'dark)
|
|
|
2711 (set-face-foreground 'font-lock-type-face
|
|
|
2712 (if (x-color-defined-p "os2pink")
|
|
|
2713 "os2pink"
|
|
|
2714 "pink")))
|
|
|
2715 (t
|
|
|
2716 (set-face-background 'font-lock-type-face "gray90"))))
|
|
|
2717 (if (is-face 'font-lock-other-type-face)
|
|
|
2718 nil
|
|
|
2719 (copy-face 'font-lock-type-face 'font-lock-other-type-face)
|
|
|
2720 (cond
|
|
|
2721 ((eq background 'light)
|
|
|
2722 (set-face-foreground 'font-lock-other-type-face
|
|
|
2723 (if (x-color-defined-p "chartreuse3")
|
|
|
2724 "chartreuse3"
|
|
|
2725 "chartreuse")))
|
|
|
2726 ((eq background 'dark)
|
|
|
2727 (set-face-foreground 'font-lock-other-type-face
|
|
|
2728 (if (x-color-defined-p "orchid1")
|
|
|
2729 "orchid1"
|
|
|
2730 "orange")))))
|
|
|
2731 (if (is-face 'font-lock-other-emphasized-face) nil
|
|
|
2732 (copy-face 'bold-italic 'font-lock-other-emphasized-face)
|
|
|
2733 (cond
|
|
|
2734 ((eq background 'light)
|
|
|
2735 (set-face-background 'font-lock-other-emphasized-face
|
|
|
2736 (if (x-color-defined-p "lightyellow2")
|
|
|
2737 "lightyellow2"
|
|
|
2738 (if (x-color-defined-p "lightyellow")
|
|
|
2739 "lightyellow"
|
|
|
2740 "light yellow"))))
|
|
|
2741 ((eq background 'dark)
|
|
|
2742 (set-face-background 'font-lock-other-emphasized-face
|
|
|
2743 (if (x-color-defined-p "navy")
|
|
|
2744 "navy"
|
|
|
2745 (if (x-color-defined-p "darkgreen")
|
|
|
2746 "darkgreen"
|
|
|
2747 "dark green"))))
|
|
|
2748 (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
|
|
|
2749 (if (is-face 'font-lock-emphasized-face) nil
|
|
|
2750 (copy-face 'bold 'font-lock-emphasized-face)
|
|
|
2751 (cond
|
|
|
2752 ((eq background 'light)
|
|
|
2753 (set-face-background 'font-lock-emphasized-face
|
|
|
2754 (if (x-color-defined-p "lightyellow2")
|
|
|
2755 "lightyellow2"
|
|
|
2756 "lightyellow")))
|
|
|
2757 ((eq background 'dark)
|
|
|
2758 (set-face-background 'font-lock-emphasized-face
|
|
|
2759 (if (x-color-defined-p "navy")
|
|
|
2760 "navy"
|
|
|
2761 (if (x-color-defined-p "darkgreen")
|
|
|
2762 "darkgreen"
|
|
|
2763 "dark green"))))
|
|
|
2764 (t (set-face-background 'font-lock-emphasized-face "gray90"))))
|
|
|
2765 (if (is-face 'font-lock-variable-name-face) nil
|
|
|
2766 (copy-face 'italic 'font-lock-variable-name-face))
|
|
|
2767 (if (is-face 'font-lock-reference-face) nil
|
|
|
2768 (copy-face 'italic 'font-lock-reference-face))))
|
|
|
2769 (setq cperl-faces-init t))
|
|
|
2770 (error nil)))
|
|
|
2771
|
|
|
2772
|
|
|
2773 (defun cperl-ps-print-init ()
|
|
|
2774 "Initialization of `ps-print' components for faces used in CPerl."
|
|
|
2775 ;; Guard against old versions
|
|
|
2776 (defvar ps-underlined-faces nil)
|
|
|
2777 (defvar ps-bold-faces nil)
|
|
|
2778 (defvar ps-italic-faces nil)
|
|
|
2779 (setq ps-bold-faces
|
|
|
2780 (append '(font-lock-emphasized-face
|
|
|
2781 font-lock-keyword-face
|
|
|
2782 font-lock-variable-name-face
|
|
|
2783 font-lock-reference-face
|
|
|
2784 font-lock-other-emphasized-face)
|
|
|
2785 ps-bold-faces))
|
|
|
2786 (setq ps-italic-faces
|
|
|
2787 (append '(font-lock-other-type-face
|
|
|
2788 font-lock-reference-face
|
|
|
2789 font-lock-other-emphasized-face)
|
|
|
2790 ps-italic-faces))
|
|
|
2791 (setq ps-underlined-faces
|
|
|
2792 (append '(font-lock-emphasized-face
|
|
|
2793 font-lock-other-emphasized-face
|
|
|
2794 font-lock-other-type-face font-lock-type-face)
|
|
|
2795 ps-underlined-faces))
|
|
|
2796 (cons 'font-lock-type-face ps-underlined-faces))
|
|
|
2797
|
|
|
2798
|
|
|
2799 (if (cperl-enable-font-lock) (cperl-windowed-init))
|
|
|
2800
|
|
|
2801 (defun cperl-set-style (style)
|
|
|
2802 "Set CPerl-mode variables to use one of several different indentation styles.
|
|
|
2803 The arguments are a string representing the desired style.
|
|
|
2804 Available styles are GNU, K&R, BSD and Whitesmith."
|
|
|
2805 (interactive
|
|
|
2806 (let ((list (mapcar (function (lambda (elt) (list (car elt))))
|
|
|
2807 c-style-alist)))
|
|
|
2808 (list (completing-read "Enter style: " list nil 'insist))))
|
|
|
2809 (let ((style (cdr (assoc style c-style-alist))) setting str sym)
|
|
|
2810 (while style
|
|
|
2811 (setq setting (car style) style (cdr style))
|
|
|
2812 (setq str (symbol-name (car setting)))
|
|
|
2813 (and (string-match "^c-" str)
|
|
|
2814 (setq str (concat "cperl-" (substring str 2)))
|
|
|
2815 (setq sym (intern-soft str))
|
|
|
2816 (boundp sym)
|
|
|
2817 (set sym (cdr setting))))))
|
|
|
2818
|
|
|
2819 (defun cperl-check-syntax ()
|
|
|
2820 (interactive)
|
|
|
2821 (require 'mode-compile)
|
|
|
2822 (let ((perl-dbg-flags "-wc"))
|
|
|
2823 (mode-compile)))
|
|
|
2824
|
|
|
2825 (defun cperl-info-buffer ()
|
|
|
2826 ;; Returns buffer with documentation. Creats if missing
|
|
|
2827 (let ((info (get-buffer "*info-perl*")))
|
|
|
2828 (if info info
|
|
|
2829 (save-window-excursion
|
|
|
2830 ;; Get Info running
|
|
|
2831 (require 'info)
|
|
|
2832 (save-window-excursion
|
|
|
2833 (info))
|
|
|
2834 (Info-find-node "perl5" "perlfunc")
|
|
|
2835 (set-buffer "*info*")
|
|
|
2836 (rename-buffer "*info-perl*")
|
|
|
2837 (current-buffer)))))
|
|
|
2838
|
|
|
2839 (defun cperl-word-at-point (&optional p)
|
|
|
2840 ;; Returns the word at point or at P.
|
|
|
2841 (save-excursion
|
|
|
2842 (if p (goto-char p))
|
|
|
2843 (require 'etags)
|
|
|
2844 (funcall (or (and (boundp 'find-tag-default-function)
|
|
|
2845 find-tag-default-function)
|
|
|
2846 (get major-mode 'find-tag-default-function)
|
|
|
2847 ;; XEmacs 19.12 has `find-tag-default-hook'; it is
|
|
|
2848 ;; automatically used within `find-tag-default':
|
|
|
2849 'find-tag-default))))
|
|
|
2850
|
|
|
2851 (defun cperl-info-on-command (command)
|
|
|
2852 "Shows documentation for Perl command in other window."
|
|
|
2853 (interactive
|
|
|
2854 (let* ((default (cperl-word-at-point))
|
|
|
2855 (read (read-string
|
|
|
2856 (format "Find doc for Perl function (default %s): "
|
|
|
2857 default))))
|
|
|
2858 (list (if (equal read "")
|
|
|
2859 default
|
|
|
2860 read))))
|
|
|
2861
|
|
|
2862 (let ((buffer (current-buffer))
|
|
|
2863 (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
|
|
|
2864 pos)
|
|
|
2865 (if (string-match "^-[a-zA-Z]$" command)
|
|
|
2866 (setq cmd-desc "^-X[ \t\n]"))
|
|
|
2867 (set-buffer (cperl-info-buffer))
|
|
|
2868 (beginning-of-buffer)
|
|
|
2869 (re-search-forward "^-X[ \t\n]")
|
|
|
2870 (forward-line -1)
|
|
|
2871 (if (re-search-forward cmd-desc nil t)
|
|
|
2872 (progn
|
|
|
2873 (setq pos (progn (beginning-of-line)
|
|
|
2874 (point)))
|
|
|
2875 (pop-to-buffer (cperl-info-buffer))
|
|
|
2876 (set-window-start (selected-window) pos))
|
|
|
2877 (message "No entry for %s found." command))
|
|
|
2878 (pop-to-buffer buffer)))
|
|
|
2879
|
|
|
2880 (defun cperl-info-on-current-command ()
|
|
|
2881 "Shows documentation for Perl command at point in other window."
|
|
|
2882 (interactive)
|
|
|
2883 (cperl-info-on-command (cperl-word-at-point)))
|
|
|
2884
|
|
|
2885 (defun cperl-imenu-info-imenu-search ()
|
|
|
2886 (if (looking-at "^-X[ \t\n]") nil
|
|
|
2887 (re-search-backward
|
|
|
2888 "^\n\\([-a-zA-Z]+\\)[ \t\n]")
|
|
|
2889 (forward-line 1)))
|
|
|
2890
|
|
|
2891 (defun cperl-imenu-info-imenu-name ()
|
|
|
2892 (buffer-substring
|
|
|
2893 (match-beginning 1) (match-end 1)))
|
|
|
2894
|
|
|
2895 (defun cperl-imenu-on-info ()
|
|
|
2896 (interactive)
|
|
|
2897 (let* ((buffer (current-buffer))
|
|
|
2898 imenu-create-index-function
|
|
|
2899 imenu-prev-index-position-function
|
|
|
2900 imenu-extract-index-name-function
|
|
|
2901 (index-item (save-restriction
|
|
|
2902 (save-window-excursion
|
|
|
2903 (set-buffer (cperl-info-buffer))
|
|
|
2904 (setq imenu-create-index-function
|
|
|
2905 'imenu-default-create-index-function
|
|
|
2906 imenu-prev-index-position-function
|
|
|
2907 'cperl-imenu-info-imenu-search
|
|
|
2908 imenu-extract-index-name-function
|
|
|
2909 'cperl-imenu-info-imenu-name)
|
|
|
2910 (imenu-choose-buffer-index)))))
|
|
|
2911 (and index-item
|
|
|
2912 (progn
|
|
|
2913 (push-mark)
|
|
|
2914 (pop-to-buffer "*info-perl*")
|
|
|
2915 (cond
|
|
|
2916 ((markerp (cdr index-item))
|
|
|
2917 (goto-char (marker-position (cdr index-item))))
|
|
|
2918 (t
|
|
|
2919 (goto-char (cdr index-item))))
|
|
|
2920 (set-window-start (selected-window) (point))
|
|
|
2921 (pop-to-buffer buffer)))))
|
|
|
2922
|
|
|
2923 (defun cperl-lineup (beg end &optional step minshift)
|
|
|
2924 "Lineup construction in a region.
|
|
|
2925 Beginning of region should be at the start of a construction.
|
|
|
2926 All first occurences of this construction in the lines that are
|
|
|
2927 partially contained in the region are lined up at the same column.
|
|
|
2928
|
|
|
2929 MINSHIFT is the minimal amount of space to insert before the construction.
|
|
|
2930 STEP is the tabwidth to position constructions.
|
|
|
2931 If STEP is `nil', `cperl-lineup-step' will be used
|
|
|
2932 \(or `cperl-indent-level', if `cperl-lineup-step' is `nil').
|
|
|
2933 Will not move the position at the start to the left."
|
|
|
2934 (interactive "r")
|
|
|
2935 (let (search col tcol seen b e)
|
|
|
2936 (save-excursion
|
|
|
2937 (goto-char end)
|
|
|
2938 (end-of-line)
|
|
|
2939 (setq end (point-marker))
|
|
|
2940 (goto-char beg)
|
|
|
2941 (skip-chars-forward " \t\f")
|
|
|
2942 (setq beg (point-marker))
|
|
|
2943 (indent-region beg end nil)
|
|
|
2944 (goto-char beg)
|
|
|
2945 (setq col (current-column))
|
|
|
2946 (if (looking-at "\\sw")
|
|
|
2947 (if (looking-at "\\<\\sw+\\>")
|
|
|
2948 (setq search
|
|
|
2949 (concat "\\<"
|
|
|
2950 (regexp-quote
|
|
|
2951 (buffer-substring (match-beginning 0)
|
|
|
2952 (match-end 0))) "\\>"))
|
|
|
2953 (error "Cannot line up in a middle of the word"))
|
|
|
2954 (if (looking-at "$")
|
|
|
2955 (error "Cannot line up end of line"))
|
|
|
2956 (setq search (regexp-quote (char-to-string (following-char)))))
|
|
|
2957 (setq step (or step cperl-lineup-step cperl-indent-level))
|
|
|
2958 (or minshift (setq minshift 1))
|
|
|
2959 (while (progn
|
|
|
2960 (beginning-of-line 2)
|
|
|
2961 (and (< (point) end)
|
|
|
2962 (re-search-forward search end t)
|
|
|
2963 (goto-char (match-beginning 0))))
|
|
|
2964 (setq tcol (current-column) seen t)
|
|
|
2965 (if (> tcol col) (setq col tcol)))
|
|
|
2966 (or seen
|
|
|
2967 (error "The construction to line up occured only once"))
|
|
|
2968 (goto-char beg)
|
|
|
2969 (setq col (+ col minshift))
|
|
|
2970 (if (/= (% col step) 0) (setq step (* step (1+ (/ col step)))))
|
|
|
2971 (while
|
|
|
2972 (progn
|
|
|
2973 (setq e (point))
|
|
|
2974 (skip-chars-backward " \t")
|
|
|
2975 (delete-region (point) e)
|
|
|
2976 (indent-to-column col); (make-string (- col (current-column)) ?\ ))
|
|
|
2977 (beginning-of-line 2)
|
|
|
2978 (and (< (point) end)
|
|
|
2979 (re-search-forward search end t)
|
|
|
2980 (goto-char (match-beginning 0)))))))) ; No body
|
|
|
2981
|
|
|
2982 (defun cperl-etags (&optional add all files)
|
|
|
2983 "Run etags with appropriate options for Perl files.
|
|
|
2984 If optional argument ALL is `recursive', will process Perl files
|
|
|
2985 in subdirectories too."
|
|
|
2986 (interactive)
|
|
|
2987 (let ((cmd "etags")
|
|
|
2988 (args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\([{#]\\|$\\)\\)/\\4/"))
|
|
|
2989 res)
|
|
|
2990 (if add (setq args (cons "-a" args)))
|
|
|
2991 (or files (setq files (list buffer-file-name)))
|
|
|
2992 (cond
|
|
|
2993 ((eq all 'recursive)
|
|
|
2994 ;;(error "Not implemented: recursive")
|
|
|
2995 (setq args (append (list "-e"
|
|
|
2996 "sub wanted {push @ARGV, $File::Find::name if /\\.[Pp][Llm]$/}
|
|
|
2997 use File::Find;
|
|
|
2998 find(\\&wanted, '.');
|
|
|
2999 exec @ARGV;"
|
|
|
3000 cmd) args)
|
|
|
3001 cmd "perl"))
|
|
|
3002 (all
|
|
|
3003 ;;(error "Not implemented: all")
|
|
|
3004 (setq args (append (list "-e"
|
|
|
3005 "push @ARGV, <*.PL *.pl *.pm>;
|
|
|
3006 exec @ARGV;"
|
|
|
3007 cmd) args)
|
|
|
3008 cmd "perl"))
|
|
|
3009 (t
|
|
|
3010 (setq args (append args files))))
|
|
|
3011 (setq res (apply 'call-process cmd nil nil nil args))
|
|
|
3012 (or (eq res 0)
|
|
|
3013 (message "etags returned \"%s\"" res))))
|
|
|
3014
|
|
|
3015 (defun cperl-toggle-auto-newline ()
|
|
|
3016 "Toggle the state of `cperl-auto-newline'."
|
|
|
3017 (interactive)
|
|
|
3018 (setq cperl-auto-newline (not cperl-auto-newline))
|
|
|
3019 (message "Newlines will %sbe auto-inserted now."
|
|
|
3020 (if cperl-auto-newline "" "not ")))
|
|
|
3021
|
|
|
3022 (defun cperl-toggle-abbrev ()
|
|
|
3023 "Toggle the state of automatic keyword expansion in CPerl mode."
|
|
|
3024 (interactive)
|
|
|
3025 (abbrev-mode (if abbrev-mode 0 1))
|
|
|
3026 (message "Perl control structure will %sbe auto-inserted now."
|
|
|
3027 (if abbrev-mode "" "not ")))
|
|
|
3028
|
|
|
3029
|
|
|
3030 (defun cperl-toggle-electric ()
|
|
|
3031 "Toggle the state of parentheses doubling in CPerl mode."
|
|
|
3032 (interactive)
|
|
|
3033 (setq cperl-electric-parens (if (cperl-val 'cperl-electric-parens) 'null t))
|
|
|
3034 (message "Parentheses will %sbe auto-doubled now."
|
|
|
3035 (if (cperl-val 'cperl-electric-parens) "" "not ")))
|
|
|
3036
|
