|
0
|
1 ;;; perl-mode.el --- Perl code editing commands for GNU Emacs
|
|
|
2
|
|
|
3 ;; Copyright (C) 1990, 1994 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 XEmacs.
|
|
|
14
|
|
|
15 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
16 ;; under the terms of the GNU General Public License as published by
|
|
|
17 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
18 ;; any later version.
|
|
|
19
|
|
|
20 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
23 ;; General Public License for more details.
|
|
|
24
|
|
|
25 ;; You should have received a copy of the GNU General Public License
|
|
|
26 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
27 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
28
|
|
|
29 ;;; Synched up with: FSF 19.30.
|
|
|
30
|
|
|
31 ;;; Commentary:
|
|
|
32
|
|
|
33 ;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
|
|
|
34 ;; to your .emacs file and change the first line of your perl script to:
|
|
|
35 ;; #!/usr/bin/perl -- # -*-Perl-*-
|
|
|
36 ;; With argments to perl:
|
|
|
37 ;; #!/usr/bin/perl -P- # -*-Perl-*-
|
|
|
38 ;; To handle files included with do 'filename.pl';, add something like
|
|
|
39 ;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
|
|
|
40 ;; auto-mode-alist))
|
|
|
41 ;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
|
|
|
42
|
|
|
43 ;; This code is based on the 18.53 version c-mode.el, with extensive
|
|
|
44 ;; rewriting. Most of the features of c-mode survived intact.
|
|
|
45
|
|
|
46 ;; I added a new feature which adds functionality to TAB; it is controlled
|
|
|
47 ;; by the variable perl-tab-to-comment. With it enabled, TAB does the
|
|
|
48 ;; first thing it can from the following list: change the indentation;
|
|
|
49 ;; move past leading white space; delete an empty comment; reindent a
|
|
|
50 ;; comment; move to end of line; create an empty comment; tell you that
|
|
|
51 ;; the line ends in a quoted string, or has a # which should be a \#.
|
|
|
52
|
|
|
53 ;; If your machine is slow, you may want to remove some of the bindings
|
|
|
54 ;; to electric-perl-terminator. I changed the indenting defaults to be
|
|
|
55 ;; what Larry Wall uses in perl/lib, but left in all the options.
|
|
|
56
|
|
|
57 ;; I also tuned a few things: comments and labels starting in column
|
|
|
58 ;; zero are left there by indent-perl-exp; perl-beginning-of-function
|
|
|
59 ;; goes back to the first open brace/paren in column zero, the open brace
|
|
|
60 ;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp
|
|
|
61 ;; (meta-^q) indents from the current line through the close of the next
|
|
|
62 ;; brace/paren, so you don't need to start exactly at a brace or paren.
|
|
|
63
|
|
|
64 ;; It may be good style to put a set of redundant braces around your
|
|
|
65 ;; main program. This will let you reindent it with meta-^q.
|
|
|
66
|
|
|
67 ;; Known problems (these are all caused by limitations in the Emacs Lisp
|
|
|
68 ;; parsing routine (parse-partial-sexp), which was not designed for such
|
|
|
69 ;; a rich language; writing a more suitable parser would be a big job):
|
|
|
70 ;; 1) Regular expression delimiters do not act as quotes, so special
|
|
|
71 ;; characters such as `'"#:;[](){} may need to be backslashed
|
|
|
72 ;; in regular expressions and in both parts of s/// and tr///.
|
|
|
73 ;; 2) The globbing syntax <pattern> is not recognized, so special
|
|
|
74 ;; characters in the pattern string must be backslashed.
|
|
|
75 ;; 3) The q, qq, and << quoting operators are not recognized; see below.
|
|
|
76 ;; 4) \ (backslash) always quotes the next character, so '\' is
|
|
|
77 ;; treated as the start of a string. Use "\\" as a work-around.
|
|
|
78 ;; 5) To make variables such a $' and $#array work, perl-mode treats
|
|
|
79 ;; $ just like backslash, so '$' is the same as problem 5.
|
|
|
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 ;; To solve problem 6, add a /{/; before each use of ${var}:
|
|
|
94 ;; /{/; while (<${glob_me}>) ...
|
|
|
95 ;;
|
|
|
96 ;; Problem 7 is even worse, but this 'fix' does work :-(
|
|
|
97 ;; $DB'stop#'
|
|
|
98 ;; [$DB'line#'
|
|
|
99 ;; ] =~ s/;9$//;
|
|
|
100
|
|
|
101
|
|
|
102 ;;; Code:
|
|
|
103
|
|
|
104 (defvar perl-mode-abbrev-table nil
|
|
|
105 "Abbrev table in use in perl-mode buffers.")
|
|
|
106 (define-abbrev-table 'perl-mode-abbrev-table ())
|
|
|
107
|
|
|
108 (defvar perl-mode-map ()
|
|
|
109 "Keymap used in Perl mode.")
|
|
|
110 (if perl-mode-map
|
|
|
111 ()
|
|
|
112 (setq perl-mode-map (make-sparse-keymap))
|
|
|
113 (set-keymap-name perl-mode-map 'perl-mode-map)
|
|
|
114 (define-key perl-mode-map "{" 'electric-perl-terminator)
|
|
|
115 (define-key perl-mode-map "}" 'electric-perl-terminator)
|
|
|
116 (define-key perl-mode-map ";" 'electric-perl-terminator)
|
|
|
117 (define-key perl-mode-map ":" 'electric-perl-terminator)
|
|
|
118 (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function)
|
|
|
119 (define-key perl-mode-map "\e\C-e" 'perl-end-of-function)
|
|
|
120 (define-key perl-mode-map "\e\C-h" 'mark-perl-function)
|
|
|
121 (define-key perl-mode-map "\e\C-q" 'indent-perl-exp)
|
|
|
122 (define-key perl-mode-map "\177" 'backward-delete-char-untabify)
|
|
|
123 (define-key perl-mode-map "\t" 'perl-indent-command))
|
|
|
124
|
|
|
125 (autoload 'c-macro-expand "cmacexp"
|
|
|
126 "Display the result of expanding all C macros occurring in the region.
|
|
|
127 The expansion is entirely correct because it uses the C preprocessor."
|
|
|
128 t)
|
|
|
129
|
|
|
130 (defvar perl-mode-syntax-table nil
|
|
|
131 "Syntax table in use in perl-mode buffers.")
|
|
|
132
|
|
|
133 (if perl-mode-syntax-table
|
|
|
134 ()
|
|
|
135 (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table)))
|
|
|
136 (modify-syntax-entry ?\n ">" perl-mode-syntax-table)
|
|
|
137 (modify-syntax-entry ?# "<" perl-mode-syntax-table)
|
|
|
138 (modify-syntax-entry ?$ "\\" perl-mode-syntax-table)
|
|
|
139 (modify-syntax-entry ?% "." perl-mode-syntax-table)
|
|
|
140 (modify-syntax-entry ?& "." perl-mode-syntax-table)
|
|
|
141 (modify-syntax-entry ?\' "\"" perl-mode-syntax-table)
|
|
|
142 (modify-syntax-entry ?* "." perl-mode-syntax-table)
|
|
|
143 (modify-syntax-entry ?+ "." perl-mode-syntax-table)
|
|
|
144 (modify-syntax-entry ?- "." perl-mode-syntax-table)
|
|
|
145 (modify-syntax-entry ?/ "." perl-mode-syntax-table)
|
|
|
146 (modify-syntax-entry ?< "." perl-mode-syntax-table)
|
|
|
147 (modify-syntax-entry ?= "." perl-mode-syntax-table)
|
|
|
148 (modify-syntax-entry ?> "." perl-mode-syntax-table)
|
|
|
149 (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table)
|
|
|
150 (modify-syntax-entry ?` "\"" perl-mode-syntax-table)
|
|
|
151 (modify-syntax-entry ?| "." perl-mode-syntax-table)
|
|
|
152 )
|
|
|
153
|
|
|
154 ;(defvar perl-imenu-generic-expression
|
|
|
155 ; '(
|
|
|
156 ; ;; Functions
|
|
|
157 ; (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1 )
|
|
|
158 ; ;;Variables
|
|
|
159 ; ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1 )
|
|
|
160 ; )
|
|
|
161 ; "Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
|
|
|
162
|
|
|
163 (defvar perl-font-lock-keywords (purecopy
|
|
|
164 (list
|
|
|
165 ; ("if" "until" "while" "elsif" "else" "unless" "for" "foreach" "continue"
|
|
|
166 ; "exit" "die" "last" "goto" "next" "redo" "return" "local" "exec")
|
|
|
167 (concat "\\<\\("
|
|
|
168 "continue\\|die\\|e\\(ls\\(e\\|if\\)\\|x\\(ec\\|it\\)\\)\\|"
|
|
|
169 "for\\(\\|each\\)\\|goto\\|if\\|l\\(ast\\|ocal\\)\\|next\\|"
|
|
|
170 "re\\(do\\|turn\\)\\|un\\(less\\|til\\)\\|while"
|
|
|
171 "\\)\\>")
|
|
|
172 ; ("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" "#define" "#undef")
|
|
|
173 (cons (concat "#\\(define\\|e\\(lse\\|ndif\\)\\|"
|
|
|
174 "i\\(f\\(\\|def\\|ndef\\)\\|nclude\\)\\|undef\\)\\>")
|
|
|
175 'font-lock-reference-face)
|
|
|
176 '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face)
|
|
|
177 '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face)
|
|
|
178 '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face)
|
|
|
179 ))
|
|
|
180 "Additional expressions to highlight in Perl mode.")
|
|
|
181
|
|
|
182 ;A similar version.
|
|
|
183 ;(defconst perl-font-lock-keywords (purecopy
|
|
|
184 ; (list
|
|
|
185 ; (cons (concat "[ \n\t{]*\\("
|
|
|
186 ; (mapconcat 'identity
|
|
|
187 ; '("if" "until" "while" "elsif" "else" "unless"
|
|
|
188 ; "for" "foreach" "continue" "exit" "die" "last"
|
|
|
189 ; "goto" "next" "redo" "return" "local" "exec")
|
|
|
190 ; "\\|")
|
|
|
191 ; "\\)[ \n\t;(]")
|
|
|
192 ; 1)
|
|
|
193 ; (mapconcat 'identity
|
|
|
194 ; '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include"
|
|
|
195 ; "#define" "#undef")
|
|
|
196 ; "\\|")
|
|
|
197 ; '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \n\t]*\\{"
|
|
|
198 ; 1 font-lock-function-name-face)
|
|
|
199 ; '("[ \n\t{]*\\(eval\\)[ \n\t(;]"
|
|
|
200 ; 1 font-lock-function-name-face)
|
|
|
201 ; ;; '("\\(--- .* ---\\|=== .* ===\\)" 1 font-lock-doc-string-face)
|
|
|
202 ; ))
|
|
|
203 ; "Additional expressions to highlight in Perl mode.")
|
|
|
204
|
|
|
205 (put 'perl-mode 'font-lock-defaults '(perl-font-lock-keywords))
|
|
|
206
|
|
|
207 (defvar perl-indent-level 4
|
|
|
208 "*Indentation of Perl statements with respect to containing block.")
|
|
|
209 (defvar perl-continued-statement-offset 4
|
|
|
210 "*Extra indent for lines not starting new statements.")
|
|
|
211 (defvar perl-continued-brace-offset -4
|
|
|
212 "*Extra indent for substatements that start with open-braces.
|
|
|
213 This is in addition to `perl-continued-statement-offset'.")
|
|
|
214 (defvar perl-brace-offset 0
|
|
|
215 "*Extra indentation for braces, compared with other text in same context.")
|
|
|
216 (defvar perl-brace-imaginary-offset 0
|
|
|
217 "*Imagined indentation of an open brace that actually follows a statement.")
|
|
|
218 (defvar perl-label-offset -2
|
|
|
219 "*Offset of Perl label lines relative to usual indentation.")
|
|
|
220
|
|
|
221 (defvar perl-tab-always-indent t
|
|
|
222 "*Non-nil means TAB in Perl mode always indents the current line.
|
|
|
223 Otherwise it inserts a tab character if you type it past the first
|
|
|
224 nonwhite character on the line.")
|
|
|
225
|
|
|
226 ;; I changed the default to nil for consistency with general Emacs
|
|
|
227 ;; conventions -- rms.
|
|
|
228 (defvar perl-tab-to-comment nil
|
|
|
229 "*Non-nil means TAB moves to eol or makes a comment in some cases.
|
|
|
230 For lines which don't need indenting, TAB either indents an
|
|
|
231 existing comment, moves to end-of-line, or if at end-of-line already,
|
|
|
232 create a new comment.")
|
|
|
233
|
|
|
234 (defvar perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:"
|
|
|
235 "*Lines starting with this regular expression are not auto-indented.")
|
|
|
236
|
|
|
237 (defvar perl-mode-hook nil
|
|
|
238 "Invoked on entry to perl-mode.")
|
|
|
239
|
|
|
240
|
|
|
241 ;;;###autoload
|
|
|
242 (defun perl-mode ()
|
|
|
243 "Major mode for editing Perl code.
|
|
|
244 Expression and list commands understand all Perl brackets.
|
|
|
245 Tab indents for Perl code.
|
|
|
246 Comments are delimited with # ... \\n.
|
|
|
247 Paragraphs are separated by blank lines only.
|
|
|
248 Delete converts tabs to spaces as it moves back.
|
|
|
249 \\{perl-mode-map}
|
|
|
250 Variables controlling indentation style:
|
|
|
251 perl-tab-always-indent
|
|
|
252 Non-nil means TAB in Perl mode should always indent the current line,
|
|
|
253 regardless of where in the line point is when the TAB command is used.
|
|
|
254 perl-tab-to-comment
|
|
|
255 Non-nil means that for lines which don't need indenting, TAB will
|
|
|
256 either delete an empty comment, indent an existing comment, move
|
|
|
257 to end-of-line, or if at end-of-line already, create a new comment.
|
|
|
258 perl-nochange
|
|
|
259 Lines starting with this regular expression are not auto-indented.
|
|
|
260 perl-indent-level
|
|
|
261 Indentation of Perl statements within surrounding block.
|
|
|
262 The surrounding block's indentation is the indentation
|
|
|
263 of the line on which the open-brace appears.
|
|
|
264 perl-continued-statement-offset
|
|
|
265 Extra indentation given to a substatement, such as the
|
|
|
266 then-clause of an if or body of a while.
|
|
|
267 perl-continued-brace-offset
|
|
|
268 Extra indentation given to a brace that starts a substatement.
|
|
|
269 This is in addition to `perl-continued-statement-offset'.
|
|
|
270 perl-brace-offset
|
|
|
271 Extra indentation for line if it starts with an open brace.
|
|
|
272 perl-brace-imaginary-offset
|
|
|
273 An open brace following other text is treated as if it were
|
|
|
274 this far to the right of the start of its line.
|
|
|
275 perl-label-offset
|
|
|
276 Extra indentation for line that is a label.
|
|
|
277
|
|
|
278 Various indentation styles: K&R BSD BLK GNU LW
|
|
|
279 perl-indent-level 5 8 0 2 4
|
|
|
280 perl-continued-statement-offset 5 8 4 2 4
|
|
|
281 perl-continued-brace-offset 0 0 0 0 -4
|
|
|
282 perl-brace-offset -5 -8 0 0 0
|
|
|
283 perl-brace-imaginary-offset 0 0 4 0 0
|
|
|
284 perl-label-offset -5 -8 -2 -2 -2
|
|
|
285
|
|
|
286 Turning on Perl mode runs the normal hook `perl-mode-hook'."
|
|
|
287 (interactive)
|
|
|
288 (kill-all-local-variables)
|
|
|
289 (use-local-map perl-mode-map)
|
|
|
290 (setq major-mode 'perl-mode)
|
|
|
291 (setq mode-name "Perl")
|
|
|
292 (setq local-abbrev-table perl-mode-abbrev-table)
|
|
|
293 (set-syntax-table perl-mode-syntax-table)
|
|
|
294 (make-local-variable 'paragraph-start)
|
|
|
295 (setq paragraph-start (concat "$\\|" page-delimiter))
|
|
|
296 (make-local-variable 'paragraph-separate)
|
|
|
297 (setq paragraph-separate paragraph-start)
|
|
|
298 (make-local-variable 'paragraph-ignore-fill-prefix)
|
|
|
299 (setq paragraph-ignore-fill-prefix t)
|
|
|
300 (make-local-variable 'indent-line-function)
|
|
|
301 (setq indent-line-function 'perl-indent-line)
|
|
|
302 (make-local-variable 'require-final-newline)
|
|
|
303 (setq require-final-newline t)
|
|
|
304 (make-local-variable 'comment-start)
|
|
|
305 (setq comment-start "# ")
|
|
|
306 (make-local-variable 'comment-end)
|
|
|
307 (setq comment-end "")
|
|
|
308 (make-local-variable 'comment-column)
|
|
|
309 (setq comment-column 32)
|
|
|
310 (make-local-variable 'comment-start-skip)
|
|
|
311 (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *")
|
|
|
312 (make-local-variable 'comment-indent-function)
|
|
|
313 (setq comment-indent-function 'perl-comment-indent)
|
|
|
314 (make-local-variable 'parse-sexp-ignore-comments)
|
|
|
315 (setq parse-sexp-ignore-comments t)
|
|
|
316 ;; Tell imenu how to handle Perl.
|
|
|
317 ; (make-local-variable 'imenu-generic-expression)
|
|
|
318 ; (setq imenu-generic-expression perl-imenu-generic-expression)
|
|
|
319 (run-hooks 'perl-mode-hook))
|
|
|
320
|
|
|
321 ;; This is used by indent-for-comment
|
|
|
322 ;; to decide how much to indent a comment in Perl code
|
|
|
323 ;; based on its context.
|
|
|
324 (defun perl-comment-indent ()
|
|
|
325 (if (and (bolp) (not (eolp)))
|
|
|
326 0 ;Existing comment at bol stays there.
|
|
|
327 (save-excursion
|
|
|
328 (skip-chars-backward " \t")
|
|
|
329 (max (if (bolp) ;Else indent at comment column
|
|
|
330 0 ; except leave at least one space if
|
|
|
331 (1+ (current-column))) ; not at beginning of line.
|
|
|
332 comment-column))))
|
|
|
333
|
|
|
334 (defun electric-perl-terminator (arg)
|
|
|
335 "Insert character and adjust indentation.
|
|
|
336 If at end-of-line, and not in a comment or a quote, correct the's indentation."
|
|
|
337 (interactive "P")
|
|
|
338 (let ((insertpos (point)))
|
|
|
339 (and (not arg) ; decide whether to indent
|
|
|
340 (eolp)
|
|
|
341 (save-excursion
|
|
|
342 (beginning-of-line)
|
|
|
343 (and (not ; eliminate comments quickly
|
|
|
344 (re-search-forward comment-start-skip insertpos t))
|
|
|
345 (or (/= last-command-char ?:)
|
|
|
346 ;; Colon is special only after a label ....
|
|
|
347 (looking-at "\\s-*\\(\\w\\|\\s_\\)+$"))
|
|
|
348 (let ((pps (parse-partial-sexp
|
|
|
349 (perl-beginning-of-function) insertpos)))
|
|
|
350 (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))
|
|
|
351 (progn ; must insert, indent, delete
|
|
|
352 (insert-char last-command-char 1)
|
|
|
353 (perl-indent-line)
|
|
|
354 (delete-char -1))))
|
|
|
355 (self-insert-command (prefix-numeric-value arg)))
|
|
|
356
|
|
|
357 ;; not used anymore, but may be useful someday:
|
|
|
358 ;;(defun perl-inside-parens-p ()
|
|
|
359 ;; (condition-case ()
|
|
|
360 ;; (save-excursion
|
|
|
361 ;; (save-restriction
|
|
|
362 ;; (narrow-to-region (point)
|
|
|
363 ;; (perl-beginning-of-function))
|
|
|
364 ;; (goto-char (point-max))
|
|
|
365 ;; (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
|
|
|
366 ;; (error nil)))
|
|
|
367
|
|
|
368 (defun perl-indent-command (&optional arg)
|
|
|
369 "Indent current line as Perl code, or optionally, insert a tab character.
|
|
|
370
|
|
|
371 With an argument, indent the current line, regardless of other options.
|
|
|
372
|
|
|
373 If `perl-tab-always-indent' is nil and point is not in the indentation
|
|
|
374 area at the beginning of the line, simply insert a tab.
|
|
|
375
|
|
|
376 Otherwise, indent the current line. If point was within the indentation
|
|
|
377 area it is moved to the end of the indentation area. If the line was
|
|
|
378 already indented properly and point was not within the indentation area,
|
|
|
379 and if `perl-tab-to-comment' is non-nil (the default), then do the first
|
|
|
380 possible action from the following list:
|
|
|
381
|
|
|
382 1) delete an empty comment
|
|
|
383 2) move forward to start of comment, indenting if necessary
|
|
|
384 3) move forward to end of line
|
|
|
385 4) create an empty comment
|
|
|
386 5) move backward to start of comment, indenting if necessary."
|
|
|
387 (interactive "P")
|
|
|
388 (if arg ; If arg, just indent this line
|
|
|
389 (perl-indent-line "\f")
|
|
|
390 (if (and (not perl-tab-always-indent)
|
|
|
391 (> (current-column) (current-indentation)))
|
|
|
392 (insert-tab)
|
|
|
393 (let (bof lsexp delta (oldpnt (point)))
|
|
|
394 (beginning-of-line)
|
|
|
395 (setq lsexp (point))
|
|
|
396 (setq bof (perl-beginning-of-function))
|
|
|
397 (goto-char oldpnt)
|
|
|
398 (setq delta (perl-indent-line "\f\\|;?#" bof))
|
|
|
399 (and perl-tab-to-comment
|
|
|
400 (= oldpnt (point)) ; done if point moved
|
|
|
401 (if (listp delta) ; if line starts in a quoted string
|
|
|
402 (setq lsexp (or (nth 2 delta) bof))
|
|
|
403 (= delta 0)) ; done if indenting occurred
|
|
|
404 (let (eol state)
|
|
|
405 (end-of-line)
|
|
|
406 (setq eol (point))
|
|
|
407 (if (= (char-after bof) ?=)
|
|
|
408 (if (= oldpnt eol)
|
|
|
409 (message "In a format statement"))
|
|
|
410 (setq state (parse-partial-sexp lsexp eol))
|
|
|
411 (if (nth 3 state)
|
|
|
412 (if (= oldpnt eol) ; already at eol in a string
|
|
|
413 (message "In a string which starts with a %c."
|
|
|
414 (nth 3 state)))
|
|
|
415 (if (not (nth 4 state))
|
|
|
416 (if (= oldpnt eol) ; no comment, create one?
|
|
|
417 (indent-for-comment))
|
|
|
418 (beginning-of-line)
|
|
|
419 (if (re-search-forward comment-start-skip eol 'move)
|
|
|
420 (if (eolp)
|
|
|
421 (progn ; kill existing comment
|
|
|
422 (goto-char (match-beginning 0))
|
|
|
423 (skip-chars-backward " \t")
|
|
|
424 (kill-region (point) eol))
|
|
|
425 (if (or (< oldpnt (point)) (= oldpnt eol))
|
|
|
426 (indent-for-comment) ; indent existing comment
|
|
|
427 (end-of-line)))
|
|
|
428 (if (/= oldpnt eol)
|
|
|
429 (end-of-line)
|
|
|
430 (message "Use backslash to quote # characters.")
|
|
|
431 (ding t))))))))))))
|
|
|
432
|
|
|
433 (defun perl-indent-line (&optional nochange parse-start)
|
|
|
434 "Indent current line as Perl code.
|
|
|
435 Return the amount the indentation
|
|
|
436 changed by, or (parse-state) if line starts in a quoted string."
|
|
|
437 (let ((case-fold-search nil)
|
|
|
438 (pos (- (point-max) (point)))
|
|
|
439 (bof (or parse-start (save-excursion (perl-beginning-of-function))))
|
|
|
440 beg indent shift-amt)
|
|
|
441 (beginning-of-line)
|
|
|
442 (setq beg (point))
|
|
|
443 (setq shift-amt
|
|
|
444 (cond ((= (char-after bof) ?=) 0)
|
|
|
445 ((listp (setq indent (calculate-perl-indent bof))) indent)
|
|
|
446 ((looking-at (or nochange perl-nochange)) 0)
|
|
|
447 (t
|
|
|
448 (skip-chars-forward " \t\f")
|
|
|
449 (cond ((looking-at "\\(\\w\\|\\s_\\)+:")
|
|
|
450 (setq indent (max 1 (+ indent perl-label-offset))))
|
|
|
451 ((= (following-char) ?})
|
|
|
452 (setq indent (- indent perl-indent-level)))
|
|
|
453 ((= (following-char) ?{)
|
|
|
454 (setq indent (+ indent perl-brace-offset))))
|
|
|
455 (- indent (current-column)))))
|
|
|
456 (skip-chars-forward " \t\f")
|
|
|
457 (if (and (numberp shift-amt) (/= 0 shift-amt))
|
|
|
458 (progn (delete-region beg (point))
|
|
|
459 (indent-to indent)))
|
|
|
460 ;; If initial point was within line's indentation,
|
|
|
461 ;; position after the indentation. Else stay at same point in text.
|
|
|
462 (if (> (- (point-max) pos) (point))
|
|
|
463 (goto-char (- (point-max) pos)))
|
|
|
464 shift-amt))
|
|
|
465
|
|
|
466 (defun calculate-perl-indent (&optional parse-start)
|
|
|
467 "Return appropriate indentation for current line as Perl code.
|
|
|
468 In usual case returns an integer: the column to indent to.
|
|
|
469 Returns (parse-state) if line starts inside a string."
|
|
|
470 (save-excursion
|
|
|
471 (beginning-of-line)
|
|
|
472 (let ((indent-point (point))
|
|
|
473 (case-fold-search nil)
|
|
|
474 (colon-line-end 0)
|
|
|
475 state containing-sexp)
|
|
|
476 (if parse-start ;used to avoid searching
|
|
|
477 (goto-char parse-start)
|
|
|
478 (perl-beginning-of-function))
|
|
|
479 (while (< (point) indent-point) ;repeat until right sexp
|
|
|
480 (setq parse-start (point))
|
|
|
481 (setq state (parse-partial-sexp (point) indent-point 0))
|
|
|
482 ; state = (depth_in_parens innermost_containing_list last_complete_sexp
|
|
|
483 ; string_terminator_or_nil inside_commentp following_quotep
|
|
|
484 ; minimum_paren-depth_this_scan)
|
|
|
485 ; Parsing stops if depth in parentheses becomes equal to third arg.
|
|
|
486 (setq containing-sexp (nth 1 state)))
|
|
|
487 (cond ((nth 3 state) state) ; In a quoted string?
|
|
|
488 ((null containing-sexp) ; Line is at top level.
|
|
|
489 (skip-chars-forward " \t\f")
|
|
|
490 (if (= (following-char) ?{)
|
|
|
491 0 ; move to beginning of line if it starts a function body
|
|
|
492 ;; indent a little if this is a continuation line
|
|
|
493 (perl-backward-to-noncomment)
|
|
|
494 (if (or (bobp)
|
|
|
495 (memq (preceding-char) '(?\; ?\})))
|
|
|
496 0 perl-continued-statement-offset)))
|
|
|
497 ((/= (char-after containing-sexp) ?{)
|
|
|
498 ;; line is expression, not statement:
|
|
|
499 ;; indent to just after the surrounding open.
|
|
|
500 (goto-char (1+ containing-sexp))
|
|
|
501 (current-column))
|
|
|
502 (t
|
|
|
503 ;; Statement level. Is it a continuation or a new statement?
|
|
|
504 ;; Find previous non-comment character.
|
|
|
505 (perl-backward-to-noncomment)
|
|
|
506 ;; Back up over label lines, since they don't
|
|
|
507 ;; affect whether our line is a continuation.
|
|
|
508 (while (or (eq (preceding-char) ?\,)
|
|
|
509 (and (eq (preceding-char) ?:)
|
|
|
510 (memq (char-syntax (char-after (- (point) 2)))
|
|
|
511 '(?w ?_))))
|
|
|
512 (if (eq (preceding-char) ?\,)
|
|
|
513 (perl-backward-to-start-of-continued-exp containing-sexp)
|
|
|
514 (beginning-of-line))
|
|
|
515 (perl-backward-to-noncomment))
|
|
|
516 ;; Now we get the answer.
|
|
|
517 (if (not (memq (preceding-char) '(?\; ?\} ?\{)))
|
|
|
518 ;; This line is continuation of preceding line's statement;
|
|
|
519 ;; indent perl-continued-statement-offset more than the
|
|
|
520 ;; previous line of the statement.
|
|
|
521 (progn
|
|
|
522 (perl-backward-to-start-of-continued-exp containing-sexp)
|
|
|
523 (+ perl-continued-statement-offset (current-column)
|
|
|
524 (if (save-excursion (goto-char indent-point)
|
|
|
525 (looking-at "[ \t]*{"))
|
|
|
526 perl-continued-brace-offset 0)))
|
|
|
527 ;; This line starts a new statement.
|
|
|
528 ;; Position at last unclosed open.
|
|
|
529 (goto-char containing-sexp)
|
|
|
530 (or
|
|
|
531 ;; If open paren is in col 0, close brace is special
|
|
|
532 (and (bolp)
|
|
|
533 (save-excursion (goto-char indent-point)
|
|
|
534 (looking-at "[ \t]*}"))
|
|
|
535 perl-indent-level)
|
|
|
536 ;; Is line first statement after an open-brace?
|
|
|
537 ;; If no, find that first statement and indent like it.
|
|
|
538 (save-excursion
|
|
|
539 (forward-char 1)
|
|
|
540 ;; Skip over comments and labels following openbrace.
|
|
|
541 (while (progn
|
|
|
542 (skip-chars-forward " \t\f\n")
|
|
|
543 (cond ((looking-at ";?#")
|
|
|
544 (forward-line 1) t)
|
|
|
545 ((looking-at "\\(\\w\\|\\s_\\)+:")
|
|
|
546 (save-excursion
|
|
|
547 (end-of-line)
|
|
|
548 (setq colon-line-end (point)))
|
|
|
549 (search-forward ":")))))
|
|
|
550 ;; The first following code counts
|
|
|
551 ;; if it is before the line we want to indent.
|
|
|
552 (and (< (point) indent-point)
|
|
|
553 (if (> colon-line-end (point))
|
|
|
554 (- (current-indentation) perl-label-offset)
|
|
|
555 (current-column))))
|
|
|
556 ;; If no previous statement,
|
|
|
557 ;; indent it relative to line brace is on.
|
|
|
558 ;; For open paren in column zero, don't let statement
|
|
|
559 ;; start there too. If perl-indent-level is zero,
|
|
|
560 ;; use perl-brace-offset + perl-continued-statement-offset
|
|
|
561 ;; For open-braces not the first thing in a line,
|
|
|
562 ;; add in perl-brace-imaginary-offset.
|
|
|
563 (+ (if (and (bolp) (zerop perl-indent-level))
|
|
|
564 (+ perl-brace-offset perl-continued-statement-offset)
|
|
|
565 perl-indent-level)
|
|
|
566 ;; Move back over whitespace before the openbrace.
|
|
|
567 ;; If openbrace is not first nonwhite thing on the line,
|
|
|
568 ;; add the perl-brace-imaginary-offset.
|
|
|
569 (progn (skip-chars-backward " \t")
|
|
|
570 (if (bolp) 0 perl-brace-imaginary-offset))
|
|
|
571 ;; If the openbrace is preceded by a parenthesized exp,
|
|
|
572 ;; move to the beginning of that;
|
|
|
573 ;; possibly a different line
|
|
|
574 (progn
|
|
|
575 (if (eq (preceding-char) ?\))
|
|
|
576 (forward-sexp -1))
|
|
|
577 ;; Get initial indentation of the line we are on.
|
|
|
578 (current-indentation))))))))))
|
|
|
579
|
|
|
580 (defun perl-backward-to-noncomment ()
|
|
|
581 "Move point backward to after the first non-white-space, skipping comments."
|
|
|
582 (interactive)
|
|
|
583 (let (opoint stop)
|
|
|
584 (while (not stop)
|
|
|
585 (setq opoint (point))
|
|
|
586 (beginning-of-line)
|
|
|
587 (if (re-search-forward comment-start-skip opoint 'move 1)
|
|
|
588 (progn (goto-char (match-end 1))
|
|
|
589 (skip-chars-forward ";")))
|
|
|
590 (skip-chars-backward " \t\f")
|
|
|
591 (setq stop (or (bobp)
|
|
|
592 (not (bolp))
|
|
|
593 (forward-char -1))))))
|
|
|
594
|
|
|
595 (defun perl-backward-to-start-of-continued-exp (lim)
|
|
|
596 (if (= (preceding-char) ?\))
|
|
|
597 (forward-sexp -1))
|
|
|
598 (beginning-of-line)
|
|
|
599 (if (<= (point) lim)
|
|
|
600 (goto-char (1+ lim)))
|
|
|
601 (skip-chars-forward " \t\f"))
|
|
|
602
|
|
|
603 ;; note: this may be slower than the c-mode version, but I can understand it.
|
|
|
604 (defun indent-perl-exp ()
|
|
|
605 "Indent each line of the Perl grouping following point."
|
|
|
606 (interactive)
|
|
|
607 (let* ((case-fold-search nil)
|
|
|
608 (oldpnt (point-marker))
|
|
|
609 (bof-mark (save-excursion
|
|
|
610 (end-of-line 2)
|
|
|
611 (perl-beginning-of-function)
|
|
|
612 (point-marker)))
|
|
|
613 eol last-mark lsexp-mark delta)
|
|
|
614 (if (= (char-after (marker-position bof-mark)) ?=)
|
|
|
615 (message "Can't indent a format statement")
|
|
|
616 (message "Indenting Perl expression...")
|
|
|
617 (save-excursion (end-of-line) (setq eol (point)))
|
|
|
618 (save-excursion ; locate matching close paren
|
|
|
619 (while (and (not (eobp)) (<= (point) eol))
|
|
|
620 (parse-partial-sexp (point) (point-max) 0))
|
|
|
621 (setq last-mark (point-marker)))
|
|
|
622 (setq lsexp-mark bof-mark)
|
|
|
623 (beginning-of-line)
|
|
|
624 (while (< (point) (marker-position last-mark))
|
|
|
625 (setq delta (perl-indent-line nil (marker-position bof-mark)))
|
|
|
626 (if (numberp delta) ; unquoted start-of-line?
|
|
|
627 (progn
|
|
|
628 (if (eolp)
|
|
|
629 (delete-horizontal-space))
|
|
|
630 (setq lsexp-mark (point-marker))))
|
|
|
631 (end-of-line)
|
|
|
632 (setq eol (point))
|
|
|
633 (if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol))
|
|
|
634 (progn ; line ends in a comment
|
|
|
635 (beginning-of-line)
|
|
|
636 (if (or (not (looking-at "\\s-*;?#"))
|
|
|
637 (listp delta)
|
|
|
638 (and (/= 0 delta)
|
|
|
639 (= (- (current-indentation) delta) comment-column)))
|
|
|
640 (if (re-search-forward comment-start-skip eol t)
|
|
|
641 (indent-for-comment))))) ; indent existing comment
|
|
|
642 (forward-line 1))
|
|
|
643 (goto-char (marker-position oldpnt))
|
|
|
644 (message "Indenting Perl expression...done"))))
|
|
|
645
|
|
|
646 (defun perl-beginning-of-function (&optional arg)
|
|
|
647 "Move backward to next beginning-of-function, or as far as possible.
|
|
|
648 With argument, repeat that many times; negative args move forward.
|
|
|
649 Returns new value of point in all cases."
|
|
|
650 (interactive "p")
|
|
|
651 (or arg (setq arg 1))
|
|
|
652 (if (< arg 0) (forward-char 1))
|
|
|
653 (and (/= arg 0)
|
|
|
654 (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
|
|
|
655 nil 'move arg)
|
|
|
656 (goto-char (1- (match-end 0))))
|
|
|
657 (point))
|
|
|
658
|
|
|
659 ;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
|
|
|
660 ;; no bugs have been removed :-)
|
|
|
661 (defun perl-end-of-function (&optional arg)
|
|
|
662 "Move forward to next end-of-function.
|
|
|
663 The end of a function is found by moving forward from the beginning of one.
|
|
|
664 With argument, repeat that many times; negative args move backward."
|
|
|
665 (interactive "p")
|
|
|
666 (or arg (setq arg 1))
|
|
|
667 (let ((first t))
|
|
|
668 (while (and (> arg 0) (< (point) (point-max)))
|
|
|
669 (let ((pos (point)))
|
|
|
670 (while (progn
|
|
|
671 (if (and first
|
|
|
672 (progn
|
|
|
673 (forward-char 1)
|
|
|
674 (perl-beginning-of-function 1)
|
|
|
675 (not (bobp))))
|
|
|
676 nil
|
|
|
677 (or (bobp) (forward-char -1))
|
|
|
678 (perl-beginning-of-function -1))
|
|
|
679 (setq first nil)
|
|
|
680 (forward-list 1)
|
|
|
681 (skip-chars-forward " \t")
|
|
|
682 (if (looking-at "[#\n]")
|
|
|
683 (forward-line 1))
|
|
|
684 (<= (point) pos))))
|
|
|
685 (setq arg (1- arg)))
|
|
|
686 (while (< arg 0)
|
|
|
687 (let ((pos (point)))
|
|
|
688 (perl-beginning-of-function 1)
|
|
|
689 (forward-sexp 1)
|
|
|
690 (forward-line 1)
|
|
|
691 (if (>= (point) pos)
|
|
|
692 (if (progn (perl-beginning-of-function 2) (not (bobp)))
|
|
|
693 (progn
|
|
|
694 (forward-list 1)
|
|
|
695 (skip-chars-forward " \t")
|
|
|
696 (if (looking-at "[#\n]")
|
|
|
697 (forward-line 1)))
|
|
|
698 (goto-char (point-min)))))
|
|
|
699 (setq arg (1+ arg)))))
|
|
|
700
|
|
|
701 (defun mark-perl-function ()
|
|
|
702 "Put mark at end of Perl function, point at beginning."
|
|
|
703 (interactive)
|
|
|
704 (push-mark (point))
|
|
|
705 (perl-end-of-function)
|
|
|
706 (push-mark (point))
|
|
|
707 (perl-beginning-of-function)
|
|
|
708 (backward-paragraph))
|
|
|
709
|
|
12
|
710 (provide 'perl-mode)
|
|
|
711
|
|
|
712 ;;; perl-mode.el ends here
|
