Symbol prettify in prog-mode; added to perl-mode, cfengine3-mode, and emacs-lisp...
[bpt/emacs.git] / lisp / progmodes / perl-mode.el
1 ;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*-
2
3 ;; Copyright (C) 1990, 1994, 2001-2013 Free Software Foundation, Inc.
4
5 ;; Author: William F. Mann
6 ;; Maintainer: FSF
7 ;; Adapted-By: ESR
8 ;; Keywords: languages
9
10 ;; Adapted from C code editing commands 'c-mode.el', Copyright 1987 by the
11 ;; Free Software Foundation, under terms of its General Public License.
12
13 ;; This file is part of GNU Emacs.
14
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
19
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
24
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27
28 ;;; Commentary:
29
30 ;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
31 ;; to your init file and change the first line of your perl script to:
32 ;; #!/usr/bin/perl -- # -*-Perl-*-
33 ;; With arguments to perl:
34 ;; #!/usr/bin/perl -P- # -*-Perl-*-
35 ;; To handle files included with do 'filename.pl';, add something like
36 ;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
37 ;; auto-mode-alist))
38 ;; to your init file; otherwise the .pl suffix defaults to prolog-mode.
39
40 ;; This code is based on the 18.53 version c-mode.el, with extensive
41 ;; rewriting. Most of the features of c-mode survived intact.
42
43 ;; I added a new feature which adds functionality to TAB; it is controlled
44 ;; by the variable perl-tab-to-comment. With it enabled, TAB does the
45 ;; first thing it can from the following list: change the indentation;
46 ;; move past leading white space; delete an empty comment; reindent a
47 ;; comment; move to end of line; create an empty comment; tell you that
48 ;; the line ends in a quoted string, or has a # which should be a \#.
49
50 ;; If your machine is slow, you may want to remove some of the bindings
51 ;; to perl-electric-terminator. I changed the indenting defaults to be
52 ;; what Larry Wall uses in perl/lib, but left in all the options.
53
54 ;; I also tuned a few things: comments and labels starting in column
55 ;; zero are left there by perl-indent-exp; perl-beginning-of-function
56 ;; goes back to the first open brace/paren in column zero, the open brace
57 ;; in 'sub ... {', or the equal sign in 'format ... ='; perl-indent-exp
58 ;; (meta-^q) indents from the current line through the close of the next
59 ;; brace/paren, so you don't need to start exactly at a brace or paren.
60
61 ;; It may be good style to put a set of redundant braces around your
62 ;; main program. This will let you reindent it with meta-^q.
63
64 ;; Known problems (these are all caused by limitations in the Emacs Lisp
65 ;; parsing routine (parse-partial-sexp), which was not designed for such
66 ;; a rich language; writing a more suitable parser would be a big job):
67 ;; 2) The globbing syntax <pattern> is not recognized, so special
68 ;; characters in the pattern string must be backslashed.
69 ;; 3) The << quoting operators are not recognized; see below.
70 ;; 5) To make '$' work correctly, $' is not recognized as a variable.
71 ;; Use "$'" or $POSTMATCH instead.
72 ;;
73 ;; If you don't use font-lock, additional problems will appear:
74 ;; 1) Regular expression delimiters do not act as quotes, so special
75 ;; characters such as `'"#:;[](){} may need to be backslashed
76 ;; in regular expressions and in both parts of s/// and tr///.
77 ;; 4) The q and qq quoting operators are not recognized; see below.
78 ;; 5) To make variables such a $' and $#array work, perl-mode treats
79 ;; $ just like backslash, so '$' is not treated correctly.
80 ;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an
81 ;; unmatched }. See below.
82 ;; 7) When ' (quote) is used as a package name separator, perl-mode
83 ;; doesn't understand, and thinks it is seeing a quoted string.
84
85 ;; Here are some ugly tricks to bypass some of these problems: the perl
86 ;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
87 ;; but will trick perl-mode into starting a quoted string, which
88 ;; can be ended with another /`/. Assuming you have no embedded
89 ;; back-ticks, this can used to help solve problem 3:
90 ;;
91 ;; /`/; $ugly = q?"'$?; /`/;
92 ;;
93 ;; The same trick can be used for problem 6 as in:
94 ;; /{/; while (<${glob_me}>)
95 ;; but a simpler solution is to add a space between the $ and the {:
96 ;; while (<$ {glob_me}>)
97 ;;
98 ;; Problem 7 is even worse, but this 'fix' does work :-(
99 ;; $DB'stop#'
100 ;; [$DB'line#'
101 ;; ] =~ s/;9$//;
102
103 ;;; Code:
104
105 (defgroup perl nil
106 "Major mode for editing Perl code."
107 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
108 :prefix "perl-"
109 :group 'languages)
110
111 (defvar perl-mode-abbrev-table nil
112 "Abbrev table in use in perl-mode buffers.")
113 (define-abbrev-table 'perl-mode-abbrev-table ())
114
115 (defvar perl-mode-map
116 (let ((map (make-sparse-keymap)))
117 (define-key map "\e\C-a" 'perl-beginning-of-function)
118 (define-key map "\e\C-e" 'perl-end-of-function)
119 (define-key map "\e\C-h" 'perl-mark-function)
120 (define-key map "\e\C-q" 'perl-indent-exp)
121 (define-key map "\177" 'backward-delete-char-untabify)
122 map)
123 "Keymap used in Perl mode.")
124
125 (defvar perl-mode-syntax-table
126 (let ((st (make-syntax-table (standard-syntax-table))))
127 (modify-syntax-entry ?\n ">" st)
128 (modify-syntax-entry ?# "<" st)
129 ;; `$' is also a prefix char so I was tempted to say "/ p",
130 ;; but the `p' thingy basically overrides the `/' :-( --stef
131 (modify-syntax-entry ?$ "/" st)
132 (modify-syntax-entry ?% ". p" st)
133 (modify-syntax-entry ?@ ". p" st)
134 (modify-syntax-entry ?& "." st)
135 (modify-syntax-entry ?\' "\"" st)
136 (modify-syntax-entry ?* "." st)
137 (modify-syntax-entry ?+ "." st)
138 (modify-syntax-entry ?- "." st)
139 (modify-syntax-entry ?/ "." st)
140 (modify-syntax-entry ?< "." st)
141 (modify-syntax-entry ?= "." st)
142 (modify-syntax-entry ?> "." st)
143 (modify-syntax-entry ?\\ "\\" st)
144 (modify-syntax-entry ?` "\"" st)
145 (modify-syntax-entry ?| "." st)
146 st)
147 "Syntax table in use in `perl-mode' buffers.")
148
149 (defvar perl-imenu-generic-expression
150 '(;; Functions
151 (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1)
152 ;;Variables
153 ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1)
154 ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1)
155 ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
156 "Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
157
158 ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
159 ;; Jim Campbell <jec@murzim.ca.boeing.com>.
160
161 (defconst perl--prettify-symbols-alist
162 '(("->" . ?→)
163 ("=>" . ?⇒)
164 ("::" . ?∷)))
165
166 (defconst perl-font-lock-keywords-1
167 '(;; What is this for?
168 ;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face)
169 ;;
170 ;; Fontify preprocessor statements as we do in `c-font-lock-keywords'.
171 ;; Ilya Zakharevich <ilya@math.ohio-state.edu> thinks this is a bad idea.
172 ;; ("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face)
173 ;; ("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
174 ;; ("^#[ \t]*if\\>"
175 ;; ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
176 ;; (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)))
177 ;; ("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
178 ;; (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t))
179 ;;
180 ;; Fontify function and package names in declarations.
181 ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\sw+\\)?"
182 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
183 ("\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\sw+\\)?"
184 (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)))
185 "Subdued level highlighting for Perl mode.")
186
187 (defconst perl-font-lock-keywords-2
188 (append
189 perl-font-lock-keywords-1
190 `( ;; Fontify keywords, except those fontified otherwise.
191 ,(concat "\\<"
192 (regexp-opt '("if" "until" "while" "elsif" "else" "unless"
193 "do" "dump" "for" "foreach" "exit" "die"
194 "BEGIN" "END" "return" "exec" "eval") t)
195 "\\>")
196 ;;
197 ;; Fontify local and my keywords as types.
198 ("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
199 ;;
200 ;; Fontify function, variable and file name references.
201 ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
202 ;; Additionally underline non-scalar variables. Maybe this is a bad idea.
203 ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
204 ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
205 ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
206 (2 (cons font-lock-variable-name-face '(underline))))
207 ("<\\(\\sw+\\)>" 1 font-lock-constant-face)
208 ;;
209 ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
210 ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
211 (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
212 ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)))
213 "Gaudy level highlighting for Perl mode.")
214
215 (defvar perl-font-lock-keywords perl-font-lock-keywords-1
216 "Default expressions to highlight in Perl mode.")
217
218 ;; Temporary variables used to add font-lock keywords dynamically.
219 (defvar perl--augmented-font-lock-keywords)
220 (defvar perl--augmented-font-lock-keywords-1)
221 (defvar perl--augmented-font-lock-keywords-2)
222
223 (defvar perl-quote-like-pairs
224 '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>)))
225
226 ;; FIXME: handle here-docs and regexps.
227 ;; <<EOF <<"EOF" <<'EOF' (no space)
228 ;; see `man perlop'
229 ;; ?...?
230 ;; /.../
231 ;; m [...]
232 ;; m /.../
233 ;; q /.../ = '...'
234 ;; qq /.../ = "..."
235 ;; qx /.../ = `...`
236 ;; qr /.../ = precompiled regexp =~=~ m/.../
237 ;; qw /.../
238 ;; s /.../.../
239 ;; s <...> /.../
240 ;; s '...'...'
241 ;; tr /.../.../
242 ;; y /.../.../
243 ;;
244 ;; <file*glob>
245 (defun perl-syntax-propertize-function (start end)
246 (let ((case-fold-search nil))
247 (goto-char start)
248 (perl-syntax-propertize-special-constructs end)
249 (funcall
250 (syntax-propertize-rules
251 ;; Turn POD into b-style comments. Place the cut rule first since it's
252 ;; more specific.
253 ("^=cut\\>.*\\(\n\\)" (1 "> b"))
254 ("^\\(=\\)\\sw" (1 "< b"))
255 ;; Catch ${ so that ${var} doesn't screw up indentation.
256 ;; This also catches $' to handle 'foo$', although it should really
257 ;; check that it occurs inside a '..' string.
258 ("\\(\\$\\)[{']" (1 ". p"))
259 ;; Handle funny names like $DB'stop.
260 ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
261 ;; format statements
262 ("^[ \t]*format.*=[ \t]*\\(\n\\)"
263 (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
264 ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
265 ;; Be careful not to match "sub { (...) ... }".
266 ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
267 (1 "."))
268 ;; Turn __DATA__ trailer into a comment.
269 ("^\\(_\\)_\\(?:DATA\\|END\\)__[ \t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)"
270 (1 "< c") (2 "> c")
271 (0 (ignore (put-text-property (match-beginning 0) (match-end 0)
272 'syntax-multiline t))))
273 ;; Regexp and funny quotes. Distinguishing a / that starts a regexp
274 ;; match from the division operator is ...interesting.
275 ;; Basically, / is a regexp match if it's preceded by an infix operator
276 ;; (or some similar separator), or by one of the special keywords
277 ;; corresponding to builtin functions that can take their first arg
278 ;; without parentheses. Of course, that presume we're looking at the
279 ;; *opening* slash. We can afford to mis-match the closing ones
280 ;; here, because they will be re-treated separately later in
281 ;; perl-font-lock-special-syntactic-constructs.
282 ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
283 (regexp-opt '("split" "if" "unless" "until" "while" "split"
284 "grep" "map" "not" "or" "and"))
285 "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
286 (2 (ignore
287 (if (and (match-end 1) ; / at BOL.
288 (save-excursion
289 (goto-char (match-end 1))
290 (forward-comment (- (point-max)))
291 (put-text-property (point) (match-end 2)
292 'syntax-multiline t)
293 (not (memq (char-before)
294 '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
295 nil ;; A division sign instead of a regexp-match.
296 (put-text-property (match-beginning 2) (match-end 2)
297 'syntax-table (string-to-syntax "\""))
298 (perl-syntax-propertize-special-constructs end)))))
299 ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)"
300 ;; Nasty cases:
301 ;; /foo/m $a->m $#m $m @m %m
302 ;; \s (appears often in regexps).
303 ;; -s file
304 ;; y => 3
305 ;; sub tr {...}
306 (3 (ignore
307 (if (save-excursion (goto-char (match-beginning 0))
308 (forward-word -1)
309 (looking-at-p "sub[ \t\n]"))
310 ;; This is defining a function.
311 nil
312 (put-text-property (match-beginning 3) (match-end 3)
313 'syntax-table
314 (if (assoc (char-after (match-beginning 3))
315 perl-quote-like-pairs)
316 (string-to-syntax "|")
317 (string-to-syntax "\"")))
318 (perl-syntax-propertize-special-constructs end)))))
319 ;; Here documents.
320 ;; TODO: Handle <<WORD. These are trickier because you need to
321 ;; disambiguate with the shift operator.
322 ("<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\).*\\(\n\\)"
323 (2 (let* ((st (get-text-property (match-beginning 2) 'syntax-table))
324 (name (match-string 1)))
325 (goto-char (match-end 1))
326 (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
327 ;; Leave the property of the newline unchanged.
328 st
329 (cons (car (string-to-syntax "< c"))
330 ;; Remember the names of heredocs found on this line.
331 (cons (pcase (aref name 0)
332 (`?\\ (substring name 1))
333 (_ (substring name 1 -1)))
334 (cdr st)))))))
335 ;; We don't call perl-syntax-propertize-special-constructs directly
336 ;; from the << rule, because there might be other elements (between
337 ;; the << and the \n) that need to be propertized.
338 ("\\(?:$\\)\\s<"
339 (0 (ignore (perl-syntax-propertize-special-constructs end))))
340 )
341 (point) end)))
342
343 (defvar perl-empty-syntax-table
344 (let ((st (copy-syntax-table)))
345 ;; Make all chars be of punctuation syntax.
346 (dotimes (i 256) (aset st i '(1)))
347 (modify-syntax-entry ?\\ "\\" st)
348 st)
349 "Syntax table used internally for processing quote-like operators.")
350
351 (defun perl-quote-syntax-table (char)
352 (let ((close (cdr (assq char perl-quote-like-pairs)))
353 (st (copy-syntax-table perl-empty-syntax-table)))
354 (if (not close)
355 (modify-syntax-entry char "\"" st)
356 (modify-syntax-entry char "(" st)
357 (modify-syntax-entry close ")" st))
358 st))
359
360 (defun perl-syntax-propertize-special-constructs (limit)
361 "Propertize special constructs like regexps and formats."
362 (let ((state (syntax-ppss))
363 char)
364 (cond
365 ((eq 2 (nth 7 state))
366 ;; A Here document.
367 (let ((names (cdr (get-text-property (nth 8 state) 'syntax-table))))
368 (when (cdr names)
369 (setq names (reverse names))
370 ;; Multiple heredocs on a single line, we have to search from the
371 ;; beginning, since we don't know which names might be
372 ;; before point.
373 (goto-char (nth 8 state)))
374 (while (and names
375 (re-search-forward
376 (concat "^" (regexp-quote (pop names)) "\n")
377 limit 'move))
378 (unless names
379 (put-text-property (1- (point)) (point) 'syntax-table
380 (string-to-syntax "> c"))))))
381 ((or (null (setq char (nth 3 state)))
382 (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
383 ;; Normal text, or comment, or docstring, or normal string.
384 nil)
385 ((eq (nth 3 state) ?\n)
386 ;; A `format' command.
387 (when (re-search-forward "^\\s *\\.\\s *\n" limit 'move)
388 (put-text-property (1- (point)) (point)
389 'syntax-table (string-to-syntax "\""))))
390 (t
391 ;; This is regexp like quote thingy.
392 (setq char (char-after (nth 8 state)))
393 (let ((startpos (point))
394 (twoargs (save-excursion
395 (goto-char (nth 8 state))
396 (skip-syntax-backward " ")
397 (skip-syntax-backward "w")
398 (member (buffer-substring
399 (point) (progn (forward-word 1) (point)))
400 '("tr" "s" "y"))))
401 (close (cdr (assq char perl-quote-like-pairs)))
402 (st (perl-quote-syntax-table char)))
403 (when (with-syntax-table st
404 (if close
405 ;; For paired delimiters, Perl allows nesting them, but
406 ;; since we treat them as strings, Emacs does not count
407 ;; those delimiters in `state', so we don't know how deep
408 ;; we are: we have to go back to the beginning of this
409 ;; "string" and count from there.
410 (condition-case nil
411 (progn
412 ;; Start after the first char since it doesn't have
413 ;; paren-syntax (an alternative would be to let-bind
414 ;; parse-sexp-lookup-properties).
415 (goto-char (1+ (nth 8 state)))
416 (up-list 1)
417 t)
418 ;; In case of error, make sure we don't move backward.
419 (scan-error (goto-char startpos) nil))
420 (not (or (nth 8 (parse-partial-sexp
421 ;; Since we don't know if point is within
422 ;; the first or the scond arg, we have to
423 ;; start from the beginning.
424 (if twoargs (1+ (nth 8 state)) (point))
425 limit nil nil state 'syntax-table))
426 ;; If we have a self-paired opener and a twoargs
427 ;; command, the form is s/../../ so we have to skip
428 ;; a second time.
429 ;; In the case of s{...}{...}, we only handle the
430 ;; first part here and the next below.
431 (when (and twoargs (not close))
432 (nth 8 (parse-partial-sexp
433 (point) limit
434 nil nil state 'syntax-table)))))))
435 ;; Point is now right after the arg(s).
436 (when (eq (char-before (1- (point))) ?$)
437 (put-text-property (- (point) 2) (1- (point))
438 'syntax-table '(1)))
439 (put-text-property (1- (point)) (point)
440 'syntax-table
441 (if close
442 (string-to-syntax "|")
443 (string-to-syntax "\"")))
444 ;; If we have two args with a non-self-paired starter (e.g.
445 ;; s{...}{...}) we're right after the first arg, so we still have to
446 ;; handle the second part.
447 (when (and twoargs close)
448 ;; Skip whitespace and make sure that font-lock will
449 ;; refontify the second part in the proper context.
450 (put-text-property
451 (point) (progn (forward-comment (point-max)) (point))
452 'syntax-multiline t)
453 ;;
454 (when (< (point) limit)
455 (put-text-property (point) (1+ (point))
456 'syntax-table
457 (if (assoc (char-after)
458 perl-quote-like-pairs)
459 ;; Put an `e' in the cdr to mark this
460 ;; char as "second arg starter".
461 (string-to-syntax "|e")
462 (string-to-syntax "\"e")))
463 (forward-char 1)
464 ;; Re-use perl-syntax-propertize-special-constructs to handle the
465 ;; second part (the first delimiter of second part can't be
466 ;; preceded by "s" or "tr" or "y", so it will not be considered
467 ;; as twoarg).
468 (perl-syntax-propertize-special-constructs limit)))))))))
469
470 (defun perl-font-lock-syntactic-face-function (state)
471 (cond
472 ((and (nth 3 state)
473 (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
474 ;; This is a second-arg of s{..}{...} form; let's check if this second
475 ;; arg is executable code rather than a string. For that, we need to
476 ;; look for an "e" after this second arg, so we have to hunt for the
477 ;; end of the arg. Depending on whether the whole arg has already
478 ;; been syntax-propertized or not, the end-char will have different
479 ;; syntaxes, so let's ignore syntax-properties temporarily so we can
480 ;; pretend it has not been syntax-propertized yet.
481 (let* ((parse-sexp-lookup-properties nil)
482 (char (char-after (nth 8 state)))
483 (paired (assq char perl-quote-like-pairs)))
484 (with-syntax-table (perl-quote-syntax-table char)
485 (save-excursion
486 (if (not paired)
487 (parse-partial-sexp (point) (point-max)
488 nil nil state 'syntax-table)
489 (condition-case nil
490 (progn
491 (goto-char (1+ (nth 8 state)))
492 (up-list 1))
493 (scan-error (goto-char (point-max)))))
494 (put-text-property (nth 8 state) (point)
495 'jit-lock-defer-multiline t)
496 (looking-at "[ \t]*\\sw*e")))))
497 nil)
498 (t (funcall (default-value 'font-lock-syntactic-face-function) state))))
499
500 (defcustom perl-indent-level 4
501 "Indentation of Perl statements with respect to containing block."
502 :type 'integer
503 :group 'perl)
504
505 ;; Is is not unusual to put both things like perl-indent-level and
506 ;; cperl-indent-level in the local variable section of a file. If only
507 ;; one of perl-mode and cperl-mode is in use, a warning will be issued
508 ;; about the variable. Autoload these here, so that no warning is
509 ;; issued when using either perl-mode or cperl-mode.
510 ;;;###autoload(put 'perl-indent-level 'safe-local-variable 'integerp)
511 ;;;###autoload(put 'perl-continued-statement-offset 'safe-local-variable 'integerp)
512 ;;;###autoload(put 'perl-continued-brace-offset 'safe-local-variable 'integerp)
513 ;;;###autoload(put 'perl-brace-offset 'safe-local-variable 'integerp)
514 ;;;###autoload(put 'perl-brace-imaginary-offset 'safe-local-variable 'integerp)
515 ;;;###autoload(put 'perl-label-offset 'safe-local-variable 'integerp)
516
517 (defcustom perl-continued-statement-offset 4
518 "Extra indent for lines not starting new statements."
519 :type 'integer
520 :group 'perl)
521 (defcustom perl-continued-brace-offset -4
522 "Extra indent for substatements that start with open-braces.
523 This is in addition to `perl-continued-statement-offset'."
524 :type 'integer
525 :group 'perl)
526 (defcustom perl-brace-offset 0
527 "Extra indentation for braces, compared with other text in same context."
528 :type 'integer
529 :group 'perl)
530 (defcustom perl-brace-imaginary-offset 0
531 "Imagined indentation of an open brace that actually follows a statement."
532 :type 'integer
533 :group 'perl)
534 (defcustom perl-label-offset -2
535 "Offset of Perl label lines relative to usual indentation."
536 :type 'integer
537 :group 'perl)
538 (defcustom perl-indent-continued-arguments nil
539 "If non-nil offset of argument lines relative to usual indentation.
540 If nil, continued arguments are aligned with the first argument."
541 :type '(choice integer (const nil))
542 :group 'perl)
543
544 (defcustom perl-indent-parens-as-block nil
545 "Non-nil means that non-block ()-, {}- and []-groups are indented as blocks.
546 The closing bracket is aligned with the line of the opening bracket,
547 not the contents of the brackets."
548 :version "24.3"
549 :type 'boolean
550 :group 'perl)
551
552 (defcustom perl-tab-always-indent tab-always-indent
553 "Non-nil means TAB in Perl mode always indents the current line.
554 Otherwise it inserts a tab character if you type it past the first
555 nonwhite character on the line."
556 :type 'boolean
557 :group 'perl)
558
559 ;; I changed the default to nil for consistency with general Emacs
560 ;; conventions -- rms.
561 (defcustom perl-tab-to-comment nil
562 "Non-nil means TAB moves to eol or makes a comment in some cases.
563 For lines which don't need indenting, TAB either indents an
564 existing comment, moves to end-of-line, or if at end-of-line already,
565 create a new comment."
566 :type 'boolean
567 :group 'perl)
568
569 (defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]"
570 "Lines starting with this regular expression are not auto-indented."
571 :type 'regexp
572 :group 'perl)
573
574 ;; Outline support
575
576 (defvar perl-outline-regexp
577 (concat (mapconcat 'cadr perl-imenu-generic-expression "\\|")
578 "\\|^=cut\\>"))
579
580 (defun perl-outline-level ()
581 (cond
582 ((looking-at "[ \t]*\\(package\\)\\s-")
583 (- (match-beginning 1) (match-beginning 0)))
584 ((looking-at "[ \t]*s\\(ub\\)\\s-")
585 (- (match-beginning 1) (match-beginning 0)))
586 ((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0))
587 ((looking-at "=cut") 1)
588 (t 3)))
589
590 (defun perl-current-defun-name ()
591 "The `add-log-current-defun' function in Perl mode."
592 (save-excursion
593 (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
594 (match-string-no-properties 1))))
595
596 \f
597 (defvar perl-mode-hook nil
598 "Normal hook to run when entering Perl mode.")
599
600 ;;;###autoload
601 (define-derived-mode perl-mode prog-mode "Perl"
602 "Major mode for editing Perl code.
603 Expression and list commands understand all Perl brackets.
604 Tab indents for Perl code.
605 Comments are delimited with # ... \\n.
606 Paragraphs are separated by blank lines only.
607 Delete converts tabs to spaces as it moves back.
608 \\{perl-mode-map}
609 Variables controlling indentation style:
610 `perl-tab-always-indent'
611 Non-nil means TAB in Perl mode should always indent the current line,
612 regardless of where in the line point is when the TAB command is used.
613 `perl-tab-to-comment'
614 Non-nil means that for lines which don't need indenting, TAB will
615 either delete an empty comment, indent an existing comment, move
616 to end-of-line, or if at end-of-line already, create a new comment.
617 `perl-nochange'
618 Lines starting with this regular expression are not auto-indented.
619 `perl-indent-level'
620 Indentation of Perl statements within surrounding block.
621 The surrounding block's indentation is the indentation
622 of the line on which the open-brace appears.
623 `perl-continued-statement-offset'
624 Extra indentation given to a substatement, such as the
625 then-clause of an if or body of a while.
626 `perl-continued-brace-offset'
627 Extra indentation given to a brace that starts a substatement.
628 This is in addition to `perl-continued-statement-offset'.
629 `perl-brace-offset'
630 Extra indentation for line if it starts with an open brace.
631 `perl-brace-imaginary-offset'
632 An open brace following other text is treated as if it were
633 this far to the right of the start of its line.
634 `perl-label-offset'
635 Extra indentation for line that is a label.
636 `perl-indent-continued-arguments'
637 Offset of argument lines relative to usual indentation.
638
639 Various indentation styles: K&R BSD BLK GNU LW
640 perl-indent-level 5 8 0 2 4
641 perl-continued-statement-offset 5 8 4 2 4
642 perl-continued-brace-offset 0 0 0 0 -4
643 perl-brace-offset -5 -8 0 0 0
644 perl-brace-imaginary-offset 0 0 4 0 0
645 perl-label-offset -5 -8 -2 -2 -2
646
647 Turning on Perl mode runs the normal hook `perl-mode-hook'."
648 :abbrev-table perl-mode-abbrev-table
649 (setq-local paragraph-start (concat "$\\|" page-delimiter))
650 (setq-local paragraph-separate paragraph-start)
651 (setq-local paragraph-ignore-fill-prefix t)
652 (setq-local indent-line-function #'perl-indent-line)
653 (setq-local comment-start "# ")
654 (setq-local comment-end "")
655 (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *")
656 (setq-local comment-indent-function #'perl-comment-indent)
657 (setq-local parse-sexp-ignore-comments t)
658
659 ;; Define the symbols to be prettified.
660 (setq-local prog-prettify-symbols-alist perl--prettify-symbols-alist)
661
662 ;; Tell font-lock.el how to handle Perl.
663 (setq perl--augmented-font-lock-keywords
664 (append perl-font-lock-keywords
665 (prog-prettify-font-lock-symbols-keywords)))
666 (setq perl--augmented-font-lock-keywords-1
667 (append perl-font-lock-keywords-1
668 (prog-prettify-font-lock-symbols-keywords)))
669 (setq perl--augmented-font-lock-keywords-2
670 (append perl-font-lock-keywords-2
671 (prog-prettify-font-lock-symbols-keywords)))
672
673 (setq font-lock-defaults '((perl--augmented-font-lock-keywords
674 perl--augmented-font-lock-keywords-1
675 perl--augmented-font-lock-keywords-2)
676 nil nil ((?\_ . "w")) nil
677 (font-lock-syntactic-face-function
678 . perl-font-lock-syntactic-face-function)))
679 (setq-local syntax-propertize-function #'perl-syntax-propertize-function)
680 (add-hook 'syntax-propertize-extend-region-functions
681 #'syntax-propertize-multiline 'append 'local)
682 ;; Electricity.
683 ;; FIXME: setup electric-layout-rules.
684 (setq-local electric-indent-chars
685 (append '(?\{ ?\} ?\; ?\:) electric-indent-chars))
686 (add-hook 'electric-indent-functions #'perl-electric-noindent-p nil t)
687 ;; Tell imenu how to handle Perl.
688 (setq-local imenu-generic-expression perl-imenu-generic-expression)
689 (setq imenu-case-fold-search nil)
690 ;; Setup outline-minor-mode.
691 (setq-local outline-regexp perl-outline-regexp)
692 (setq-local outline-level 'perl-outline-level)
693 (setq-local add-log-current-defun-function #'perl-current-defun-name))
694 \f
695 ;; This is used by indent-for-comment
696 ;; to decide how much to indent a comment in Perl code
697 ;; based on its context.
698 (defun perl-comment-indent ()
699 (if (and (bolp) (not (eolp)))
700 0 ;Existing comment at bol stays there.
701 comment-column))
702
703 (define-obsolete-function-alias 'electric-perl-terminator
704 'perl-electric-terminator "22.1")
705 (defun perl-electric-noindent-p (char)
706 (unless (eolp) 'no-indent))
707
708 (defun perl-electric-terminator (arg)
709 "Insert character and maybe adjust indentation.
710 If at end-of-line, and not in a comment or a quote, correct the indentation."
711 (interactive "P")
712 (let ((insertpos (point)))
713 (and (not arg) ; decide whether to indent
714 (eolp)
715 (save-excursion
716 (beginning-of-line)
717 (and (not ; eliminate comments quickly
718 (and comment-start-skip
719 (re-search-forward comment-start-skip insertpos t)) )
720 (or (/= last-command-event ?:)
721 ;; Colon is special only after a label ....
722 (looking-at "\\s-*\\(\\w\\|\\s_\\)+$"))
723 (let ((pps (parse-partial-sexp
724 (perl-beginning-of-function) insertpos)))
725 (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))
726 (progn ; must insert, indent, delete
727 (insert-char last-command-event 1)
728 (perl-indent-line)
729 (delete-char -1))))
730 (self-insert-command (prefix-numeric-value arg)))
731 (make-obsolete 'perl-electric-terminator 'electric-indent-mode "24.4")
732
733 ;; not used anymore, but may be useful someday:
734 ;;(defun perl-inside-parens-p ()
735 ;; (condition-case ()
736 ;; (save-excursion
737 ;; (save-restriction
738 ;; (narrow-to-region (point)
739 ;; (perl-beginning-of-function))
740 ;; (goto-char (point-max))
741 ;; (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
742 ;; (error nil)))
743 \f
744 (defun perl-indent-command (&optional arg)
745 "Indent Perl code in the active region or current line.
746 In Transient Mark mode, when the region is active, reindent the region.
747 Otherwise, with a prefix argument, reindent the current line
748 unconditionally.
749
750 Otherwise, if `perl-tab-always-indent' is nil and point is not in
751 the indentation area at the beginning of the line, insert a tab.
752
753 Otherwise, indent the current line. If point was within the
754 indentation area, it is moved to the end of the indentation area.
755 If the line was already indented properly and point was not
756 within the indentation area, and if `perl-tab-to-comment' is
757 non-nil (the default), then do the first possible action from the
758 following list:
759
760 1) delete an empty comment
761 2) move forward to start of comment, indenting if necessary
762 3) move forward to end of line
763 4) create an empty comment
764 5) move backward to start of comment, indenting if necessary."
765 (interactive "P")
766 (cond ((use-region-p) ; indent the active region
767 (indent-region (region-beginning) (region-end)))
768 (arg
769 (perl-indent-line "\f")) ; just indent this line
770 ((and (not perl-tab-always-indent)
771 (> (current-column) (current-indentation)))
772 (insert-tab))
773 (t
774 (let* ((oldpnt (point))
775 (lsexp (progn (beginning-of-line) (point)))
776 (bof (perl-beginning-of-function))
777 (delta (progn
778 (goto-char oldpnt)
779 (perl-indent-line "\f\\|;?#" bof))))
780 (and perl-tab-to-comment
781 (= oldpnt (point)) ; done if point moved
782 (if (listp delta) ; if line starts in a quoted string
783 (setq lsexp (or (nth 2 delta) bof))
784 (= delta 0)) ; done if indenting occurred
785 (let ((eol (progn (end-of-line) (point)))
786 state)
787 (cond ((= (char-after bof) ?=)
788 (if (= oldpnt eol)
789 (message "In a format statement")))
790 ((progn (setq state (parse-partial-sexp lsexp eol))
791 (nth 3 state))
792 (if (= oldpnt eol) ; already at eol in a string
793 (message "In a string which starts with a %c."
794 (nth 3 state))))
795 ((not (nth 4 state))
796 (if (= oldpnt eol) ; no comment, create one?
797 (indent-for-comment)))
798 ((progn (beginning-of-line)
799 (and comment-start-skip
800 (re-search-forward
801 comment-start-skip eol 'move)))
802 (if (eolp)
803 (progn ; delete existing comment
804 (goto-char (match-beginning 0))
805 (skip-chars-backward " \t")
806 (delete-region (point) eol))
807 (if (or (< oldpnt (point)) (= oldpnt eol))
808 (indent-for-comment) ; indent existing comment
809 (end-of-line))))
810 ((/= oldpnt eol)
811 (end-of-line))
812 (t
813 (message "Use backslash to quote # characters.")
814 (ding t)))))))))
815 (make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4")
816
817 (defun perl-indent-line (&optional nochange parse-start)
818 "Indent current line as Perl code.
819 Return the amount the indentation
820 changed by, or (parse-state) if line starts in a quoted string."
821 (let ((case-fold-search nil)
822 (pos (- (point-max) (point)))
823 (bof (or parse-start (save-excursion (perl-beginning-of-function))))
824 beg indent shift-amt)
825 (beginning-of-line)
826 (setq beg (point))
827 (setq shift-amt
828 (cond ((eq (char-after bof) ?=) 0)
829 ((listp (setq indent (perl-calculate-indent bof))) indent)
830 ((eq 'noindent indent) indent)
831 ((looking-at (or nochange perl-nochange)) 0)
832 (t
833 (skip-chars-forward " \t\f")
834 (setq indent (perl-indent-new-calculate nil indent bof))
835 (- indent (current-column)))))
836 (skip-chars-forward " \t\f")
837 (if (and (numberp shift-amt) (/= 0 shift-amt))
838 (progn (delete-region beg (point))
839 (indent-to indent)))
840 ;; If initial point was within line's indentation,
841 ;; position after the indentation. Else stay at same point in text.
842 (if (> (- (point-max) pos) (point))
843 (goto-char (- (point-max) pos)))
844 shift-amt))
845
846 (defun perl-continuation-line-p (limit)
847 "Move to end of previous line and return non-nil if continued."
848 ;; Statement level. Is it a continuation or a new statement?
849 ;; Find previous non-comment character.
850 (perl-backward-to-noncomment)
851 ;; Back up over label lines, since they don't
852 ;; affect whether our line is a continuation.
853 (while (or (eq (preceding-char) ?\,)
854 (and (eq (preceding-char) ?:)
855 (memq (char-syntax (char-after (- (point) 2)))
856 '(?w ?_))))
857 (if (eq (preceding-char) ?\,)
858 (perl-backward-to-start-of-continued-exp limit)
859 (beginning-of-line))
860 (perl-backward-to-noncomment))
861 ;; Now we get the answer.
862 (not (memq (preceding-char) '(?\; ?\} ?\{))))
863
864 (defun perl-hanging-paren-p ()
865 "Non-nil if we are right after a hanging parenthesis-like char."
866 (and (looking-at "[ \t]*$")
867 (save-excursion
868 (skip-syntax-backward " (") (not (bolp)))))
869
870 (defun perl-indent-new-calculate (&optional virtual default parse-start)
871 (or
872 (and virtual (save-excursion (skip-chars-backward " \t") (bolp))
873 (current-column))
874 (and (looking-at "\\(\\w\\|\\s_\\)+:[^:]")
875 (max 1 (+ (or default (perl-calculate-indent parse-start))
876 perl-label-offset)))
877 (and (= (char-syntax (following-char)) ?\))
878 (save-excursion
879 (forward-char 1)
880 (forward-sexp -1)
881 (perl-indent-new-calculate
882 ;; Recalculate the parsing-start, since we may have jumped
883 ;; dangerously close (typically in the case of nested functions).
884 'virtual nil (save-excursion (perl-beginning-of-function)))))
885 (and (and (= (following-char) ?{)
886 (save-excursion (forward-char) (perl-hanging-paren-p)))
887 (+ (or default (perl-calculate-indent parse-start))
888 perl-brace-offset))
889 (or default (perl-calculate-indent parse-start))))
890
891 (defun perl-calculate-indent (&optional parse-start)
892 "Return appropriate indentation for current line as Perl code.
893 In usual case returns an integer: the column to indent to.
894 Returns (parse-state) if line starts inside a string.
895 Optional argument PARSE-START should be the position of `beginning-of-defun'."
896 (save-excursion
897 (let ((indent-point (point))
898 (case-fold-search nil)
899 (colon-line-end 0)
900 state containing-sexp)
901 (if parse-start ;used to avoid searching
902 (goto-char parse-start)
903 (perl-beginning-of-function))
904 ;; We might be now looking at a local function that has nothing to
905 ;; do with us because `indent-point' is past it. In this case
906 ;; look further back up for another `perl-beginning-of-function'.
907 (while (and (looking-at "{")
908 (save-excursion
909 (beginning-of-line)
910 (looking-at "\\s-+sub\\>"))
911 (> indent-point (save-excursion
912 (condition-case nil
913 (forward-sexp 1)
914 (scan-error nil))
915 (point))))
916 (perl-beginning-of-function))
917 (while (< (point) indent-point) ;repeat until right sexp
918 (setq state (parse-partial-sexp (point) indent-point 0))
919 ;; state = (depth_in_parens innermost_containing_list
920 ;; last_complete_sexp string_terminator_or_nil inside_commentp
921 ;; following_quotep minimum_paren-depth_this_scan)
922 ;; Parsing stops if depth in parentheses becomes equal to third arg.
923 (setq containing-sexp (nth 1 state)))
924 (cond ((nth 3 state) 'noindent) ; In a quoted string?
925 ((null containing-sexp) ; Line is at top level.
926 (skip-chars-forward " \t\f")
927 (if (memq (following-char)
928 (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{)))
929 0 ; move to beginning of line if it starts a function body
930 ;; indent a little if this is a continuation line
931 (perl-backward-to-noncomment)
932 (if (or (bobp)
933 (memq (preceding-char) '(?\; ?\})))
934 0 perl-continued-statement-offset)))
935 ((/= (char-after containing-sexp) ?{)
936 ;; line is expression, not statement:
937 ;; indent to just after the surrounding open.
938 (goto-char (1+ containing-sexp))
939 (if (perl-hanging-paren-p)
940 ;; We're indenting an arg of a call like:
941 ;; $a = foobarlongnamefun (
942 ;; arg1
943 ;; arg2
944 ;; );
945 (progn
946 (skip-syntax-backward "(")
947 (condition-case nil
948 (while (save-excursion
949 (skip-syntax-backward " ") (not (bolp)))
950 (forward-sexp -1))
951 (scan-error nil))
952 (+ (current-column) perl-indent-level))
953 (if perl-indent-continued-arguments
954 (+ perl-indent-continued-arguments (current-indentation))
955 (skip-chars-forward " \t")
956 (current-column))))
957 (t
958 ;; Statement level. Is it a continuation or a new statement?
959 (if (perl-continuation-line-p containing-sexp)
960 ;; This line is continuation of preceding line's statement;
961 ;; indent perl-continued-statement-offset more than the
962 ;; previous line of the statement.
963 (progn
964 (perl-backward-to-start-of-continued-exp containing-sexp)
965 (+ (if (save-excursion
966 (perl-continuation-line-p containing-sexp))
967 ;; If the continued line is itself a continuation
968 ;; line, then align, otherwise add an offset.
969 0 perl-continued-statement-offset)
970 (current-column)
971 (if (save-excursion (goto-char indent-point)
972 (looking-at
973 (if perl-indent-parens-as-block
974 "[ \t]*[{(\[]" "[ \t]*{")))
975 perl-continued-brace-offset 0)))
976 ;; This line starts a new statement.
977 ;; Position at last unclosed open.
978 (goto-char containing-sexp)
979 (or
980 ;; Is line first statement after an open-brace?
981 ;; If no, find that first statement and indent like it.
982 (save-excursion
983 (forward-char 1)
984 ;; Skip over comments and labels following openbrace.
985 (while (progn
986 (skip-chars-forward " \t\f\n")
987 (cond ((looking-at ";?#")
988 (forward-line 1) t)
989 ((looking-at "\\(\\w\\|\\s_\\)+:[^:]")
990 (setq colon-line-end (line-end-position))
991 (search-forward ":")))))
992 ;; The first following code counts
993 ;; if it is before the line we want to indent.
994 (and (< (point) indent-point)
995 (if (> colon-line-end (point))
996 (- (current-indentation) perl-label-offset)
997 (current-column))))
998 ;; If no previous statement,
999 ;; indent it relative to line brace is on.
1000 ;; For open paren in column zero, don't let statement
1001 ;; start there too. If perl-indent-level is zero,
1002 ;; use perl-brace-offset + perl-continued-statement-offset
1003 ;; For open-braces not the first thing in a line,
1004 ;; add in perl-brace-imaginary-offset.
1005 (+ (if (and (bolp) (zerop perl-indent-level))
1006 (+ perl-brace-offset perl-continued-statement-offset)
1007 perl-indent-level)
1008 ;; Move back over whitespace before the openbrace.
1009 ;; If openbrace is not first nonwhite thing on the line,
1010 ;; add the perl-brace-imaginary-offset.
1011 (progn (skip-chars-backward " \t")
1012 (if (bolp) 0 perl-brace-imaginary-offset))
1013 ;; If the openbrace is preceded by a parenthesized exp,
1014 ;; move to the beginning of that;
1015 ;; possibly a different line
1016 (progn
1017 (if (eq (preceding-char) ?\))
1018 (forward-sexp -1))
1019 ;; Get initial indentation of the line we are on.
1020 (current-indentation))))))))))
1021
1022 (defun perl-backward-to-noncomment ()
1023 "Move point backward to after the first non-white-space, skipping comments."
1024 (interactive)
1025 (forward-comment (- (point-max))))
1026
1027 (defun perl-backward-to-start-of-continued-exp (lim)
1028 (if (= (preceding-char) ?\))
1029 (forward-sexp -1))
1030 (beginning-of-line)
1031 (if (<= (point) lim)
1032 (goto-char (1+ lim)))
1033 (skip-chars-forward " \t\f"))
1034 \f
1035 ;; note: this may be slower than the c-mode version, but I can understand it.
1036 (defalias 'indent-perl-exp 'perl-indent-exp)
1037 (defun perl-indent-exp ()
1038 "Indent each line of the Perl grouping following point."
1039 (interactive)
1040 (let* ((case-fold-search nil)
1041 (oldpnt (point-marker))
1042 (bof-mark (save-excursion
1043 (end-of-line 2)
1044 (perl-beginning-of-function)
1045 (point-marker)))
1046 eol last-mark lsexp-mark delta)
1047 (if (= (char-after (marker-position bof-mark)) ?=)
1048 (message "Can't indent a format statement")
1049 (message "Indenting Perl expression...")
1050 (setq eol (line-end-position))
1051 (save-excursion ; locate matching close paren
1052 (while (and (not (eobp)) (<= (point) eol))
1053 (parse-partial-sexp (point) (point-max) 0))
1054 (setq last-mark (point-marker)))
1055 (setq lsexp-mark bof-mark)
1056 (beginning-of-line)
1057 (while (< (point) (marker-position last-mark))
1058 (setq delta (perl-indent-line nil (marker-position bof-mark)))
1059 (if (numberp delta) ; unquoted start-of-line?
1060 (progn
1061 (if (eolp)
1062 (delete-horizontal-space))
1063 (setq lsexp-mark (point-marker))))
1064 (end-of-line)
1065 (setq eol (point))
1066 (if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol))
1067 (progn ; line ends in a comment
1068 (beginning-of-line)
1069 (if (or (not (looking-at "\\s-*;?#"))
1070 (listp delta)
1071 (and (/= 0 delta)
1072 (= (- (current-indentation) delta) comment-column)))
1073 (if (and comment-start-skip
1074 (re-search-forward comment-start-skip eol t))
1075 (indent-for-comment))))) ; indent existing comment
1076 (forward-line 1))
1077 (goto-char (marker-position oldpnt))
1078 (message "Indenting Perl expression...done"))))
1079 \f
1080 (defun perl-beginning-of-function (&optional arg)
1081 "Move backward to next beginning-of-function, or as far as possible.
1082 With argument, repeat that many times; negative args move forward.
1083 Returns new value of point in all cases."
1084 (interactive "p")
1085 (or arg (setq arg 1))
1086 (if (< arg 0) (forward-char 1))
1087 (and (/= arg 0)
1088 (re-search-backward
1089 "^\\s(\\|^\\s-*sub\\b[ \t\n]*\\_<[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
1090 nil 'move arg)
1091 (goto-char (1- (match-end 0))))
1092 (point))
1093
1094 ;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
1095 ;; no bugs have been removed :-)
1096 (defun perl-end-of-function (&optional arg)
1097 "Move forward to next end-of-function.
1098 The end of a function is found by moving forward from the beginning of one.
1099 With argument, repeat that many times; negative args move backward."
1100 (interactive "p")
1101 (or arg (setq arg 1))
1102 (let ((first t))
1103 (while (and (> arg 0) (< (point) (point-max)))
1104 (let ((pos (point)))
1105 (while (progn
1106 (if (and first
1107 (progn
1108 (forward-char 1)
1109 (perl-beginning-of-function 1)
1110 (not (bobp))))
1111 nil
1112 (or (bobp) (forward-char -1))
1113 (perl-beginning-of-function -1))
1114 (setq first nil)
1115 (forward-list 1)
1116 (skip-chars-forward " \t")
1117 (if (looking-at "[#\n]")
1118 (forward-line 1))
1119 (<= (point) pos))))
1120 (setq arg (1- arg)))
1121 (while (< arg 0)
1122 (let ((pos (point)))
1123 (perl-beginning-of-function 1)
1124 (forward-sexp 1)
1125 (forward-line 1)
1126 (if (>= (point) pos)
1127 (if (progn (perl-beginning-of-function 2) (not (bobp)))
1128 (progn
1129 (forward-list 1)
1130 (skip-chars-forward " \t")
1131 (if (looking-at "[#\n]")
1132 (forward-line 1)))
1133 (goto-char (point-min)))))
1134 (setq arg (1+ arg)))))
1135
1136 (defalias 'mark-perl-function 'perl-mark-function)
1137 (defun perl-mark-function ()
1138 "Put mark at end of Perl function, point at beginning."
1139 (interactive)
1140 (push-mark (point))
1141 (perl-end-of-function)
1142 (push-mark (point))
1143 (perl-beginning-of-function)
1144 (backward-paragraph))
1145
1146 (provide 'perl-mode)
1147
1148 ;;; perl-mode.el ends here