Mercurial > emacs
comparison lisp/progmodes/perl-mode.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; perl-mode.el --- Perl code editing commands for GNU Emacs | 1 ;;; perl-mode.el --- Perl code editing commands for GNU Emacs |
2 | 2 |
3 ;; Copyright (C) 1990, 1994 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1990, 1994, 2001, 2002, 2003, 2004, 2005 |
4 ;; Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: William F. Mann | 6 ;; Author: William F. Mann |
6 ;; Maintainer: FSF | 7 ;; Maintainer: FSF |
7 ;; Adapted-By: ESR | 8 ;; Adapted-By: ESR |
8 ;; Keywords: languages | 9 ;; Keywords: languages |
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
23 ;; GNU General Public License for more details. | 24 ;; GNU General Public License for more details. |
24 | 25 |
25 ;; You should have received a copy of the GNU General Public License | 26 ;; You should have received a copy of the GNU General Public License |
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 27 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 28 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
28 ;; Boston, MA 02111-1307, USA. | 29 ;; Boston, MA 02110-1301, USA. |
29 | 30 |
30 ;;; Commentary: | 31 ;;; Commentary: |
31 | 32 |
32 ;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode") | 33 ;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode") |
33 ;; to your .emacs file and change the first line of your perl script to: | 34 ;; to your .emacs file and change the first line of your perl script to: |
104 | 105 |
105 ;;; Code: | 106 ;;; Code: |
106 | 107 |
107 (eval-when-compile (require 'cl)) | 108 (eval-when-compile (require 'cl)) |
108 | 109 |
110 (defvar font-lock-comment-face) | |
111 (defvar font-lock-doc-face) | |
112 (defvar font-lock-string-face) | |
113 | |
109 (defgroup perl nil | 114 (defgroup perl nil |
110 "Major mode for editing Perl code." | 115 "Major mode for editing Perl code." |
116 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) | |
111 :prefix "perl-" | 117 :prefix "perl-" |
112 :group 'languages) | 118 :group 'languages) |
113 | 119 |
114 (defvar perl-mode-abbrev-table nil | 120 (defvar perl-mode-abbrev-table nil |
115 "Abbrev table in use in perl-mode buffers.") | 121 "Abbrev table in use in perl-mode buffers.") |
159 st) | 165 st) |
160 "Syntax table in use in `perl-mode' buffers.") | 166 "Syntax table in use in `perl-mode' buffers.") |
161 | 167 |
162 (defvar perl-imenu-generic-expression | 168 (defvar perl-imenu-generic-expression |
163 '(;; Functions | 169 '(;; Functions |
164 (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1 ) | 170 (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) |
165 ;;Variables | 171 ;;Variables |
166 ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1 ) | 172 ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1) |
167 ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1 )) | 173 ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) |
174 ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) | |
168 "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") | 175 "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") |
169 | 176 |
170 ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and | 177 ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and |
171 ;; Jim Campbell <jec@murzim.ca.boeing.com>. | 178 ;; Jim Campbell <jec@murzim.ca.boeing.com>. |
172 | 179 |
204 ;; | 211 ;; |
205 ;; Fontify local and my keywords as types. | 212 ;; Fontify local and my keywords as types. |
206 '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) | 213 '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) |
207 ;; | 214 ;; |
208 ;; Fontify function, variable and file name references. | 215 ;; Fontify function, variable and file name references. |
209 '("&\\(\\sw+\\)" 1 font-lock-function-name-face) | 216 '("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) |
210 ;; Additionally underline non-scalar variables. Maybe this is a bad idea. | 217 ;; Additionally underline non-scalar variables. Maybe this is a bad idea. |
211 ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) | 218 ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) |
212 '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) | 219 '("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) |
213 '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" | 220 '("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" |
214 (2 (cons font-lock-variable-name-face '(underline)))) | 221 (2 (cons font-lock-variable-name-face '(underline)))) |
215 '("<\\(\\sw+\\)>" 1 font-lock-constant-face) | 222 '("<\\(\\sw+\\)>" 1 font-lock-constant-face) |
216 ;; | 223 ;; |
217 ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. | 224 ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. |
218 '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" | 225 '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" |
244 ;; tr /.../.../ | 251 ;; tr /.../.../ |
245 ;; y /.../.../ | 252 ;; y /.../.../ |
246 ;; | 253 ;; |
247 ;; <file*glob> | 254 ;; <file*glob> |
248 (defvar perl-font-lock-syntactic-keywords | 255 (defvar perl-font-lock-syntactic-keywords |
249 ;; Turn POD into b-style comments | 256 ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") |
250 '(("^\\(=\\)\\sw" (1 "< b")) | 257 '(;; Turn POD into b-style comments |
258 ("^\\(=\\)\\sw" (1 "< b")) | |
251 ("^=cut[ \t]*\\(\n\\)" (1 "> b")) | 259 ("^=cut[ \t]*\\(\n\\)" (1 "> b")) |
252 ;; Catch ${ so that ${var} doesn't screw up indentation. | 260 ;; Catch ${ so that ${var} doesn't screw up indentation. |
253 ;; This also catches $' to handle 'foo$', although it should really | 261 ;; This also catches $' to handle 'foo$', although it should really |
254 ;; check that it occurs inside a '..' string. | 262 ;; check that it occurs inside a '..' string. |
255 ("\\(\\$\\)[{']" (1 ". p")) | 263 ("\\(\\$\\)[{']" (1 ". p")) |
258 ;; format statements | 266 ;; format statements |
259 ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) | 267 ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) |
260 ;; Funny things in sub arg specifications like `sub myfunc ($$)' | 268 ;; Funny things in sub arg specifications like `sub myfunc ($$)' |
261 ("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1)) | 269 ("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1)) |
262 ;; regexp and funny quotes | 270 ;; regexp and funny quotes |
263 ("[;(=!~{][ \t\n]*\\(/\\)" (1 '(7))) | 271 ("[?:.,;=!~({[][ \t\n]*\\(/\\)" (1 '(7))) |
264 ("[;( =!~{\t\n]\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" | 272 ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" |
265 ;; Nasty cases: | 273 ;; Nasty cases: |
266 ;; /foo/m $a->m $#m $m @m %m | 274 ;; /foo/m $a->m $#m $m @m %m |
267 ;; \s (appears often in regexps). | 275 ;; \s (appears often in regexps). |
268 ;; -s file | 276 ;; -s file |
269 (2 (if (assoc (char-after (match-beginning 2)) | 277 (3 (if (assoc (char-after (match-beginning 3)) |
270 perl-quote-like-pairs) | 278 perl-quote-like-pairs) |
271 '(15) '(7)))))) | 279 '(15) '(7)))) |
280 ;; Find and mark the end of funny quotes and format statements. | |
281 (perl-font-lock-special-syntactic-constructs) | |
282 )) | |
272 | 283 |
273 (defvar perl-empty-syntax-table | 284 (defvar perl-empty-syntax-table |
274 (let ((st (copy-syntax-table))) | 285 (let ((st (copy-syntax-table))) |
275 ;; Make all chars be of punctuation syntax. | 286 ;; Make all chars be of punctuation syntax. |
276 (dotimes (i 256) (aset st i '(1))) | 287 (dotimes (i 256) (aset st i '(1))) |
285 (modify-syntax-entry char "\"" st) | 296 (modify-syntax-entry char "\"" st) |
286 (modify-syntax-entry char "(" st) | 297 (modify-syntax-entry char "(" st) |
287 (modify-syntax-entry close ")" st)) | 298 (modify-syntax-entry close ")" st)) |
288 st)) | 299 st)) |
289 | 300 |
290 (defun perl-font-lock-syntactic-face-function (state) | 301 (defun perl-font-lock-special-syntactic-constructs (limit) |
291 (let ((char (nth 3 state))) | 302 ;; We used to do all this in a font-lock-syntactic-face-function, which |
292 (cond | 303 ;; did not work correctly because sometimes some parts of the buffer are |
293 ((not char) | 304 ;; treated with font-lock-syntactic-keywords but not with |
294 ;; Comment or docstring. | 305 ;; font-lock-syntactic-face-function (mostly because of |
295 (if (nth 7 state) font-lock-doc-face font-lock-comment-face)) | 306 ;; font-lock-syntactically-fontified). That meant that some syntax-table |
296 ((and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")) | 307 ;; properties were missing. So now we do the parse-partial-sexp loop |
297 ;; Normal string. | 308 ;; ourselves directly from font-lock-syntactic-keywords, so we're sure |
298 font-lock-string-face) | 309 ;; it's done when necessary. |
299 ((eq (nth 3 state) ?\n) | 310 (let ((state (syntax-ppss)) |
300 ;; A `format' command. | 311 char) |
301 (save-excursion | 312 (while (< (point) limit) |
302 (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) | 313 (cond |
303 (not (eobp))) | 314 ((or (null (setq char (nth 3 state))) |
304 (put-text-property (point) (1+ (point)) 'syntax-table '(7))) | 315 (and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\"))) |
305 font-lock-string-face)) | 316 ;; Normal text, or comment, or docstring, or normal string. |
306 (t | 317 nil) |
307 ;; This is regexp like quote thingy. | 318 ((eq (nth 3 state) ?\n) |
308 (setq char (char-after (nth 8 state))) | 319 ;; A `format' command. |
309 (save-excursion | 320 (save-excursion |
310 (let ((twoargs (save-excursion | 321 (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) |
311 (goto-char (nth 8 state)) | 322 (not (eobp))) |
312 (skip-syntax-backward " ") | 323 (put-text-property (point) (1+ (point)) 'syntax-table '(7))))) |
313 (skip-syntax-backward "w") | 324 (t |
314 (member (buffer-substring | 325 ;; This is regexp like quote thingy. |
315 (point) (progn (forward-word 1) (point))) | 326 (setq char (char-after (nth 8 state))) |
316 '("tr" "s" "y")))) | 327 (save-excursion |
317 (close (cdr (assq char perl-quote-like-pairs))) | 328 (let ((twoargs (save-excursion |
318 (pos (point)) | 329 (goto-char (nth 8 state)) |
319 (st (perl-quote-syntax-table char))) | 330 (skip-syntax-backward " ") |
320 (if (not close) | 331 (skip-syntax-backward "w") |
321 ;; The closing char is the same as the opening char. | 332 (member (buffer-substring |
322 (with-syntax-table st | 333 (point) (progn (forward-word 1) (point))) |
323 (parse-partial-sexp (point) (point-max) | 334 '("tr" "s" "y")))) |
324 nil nil state 'syntax-table) | 335 (close (cdr (assq char perl-quote-like-pairs))) |
325 (when twoargs | 336 (pos (point)) |
326 (parse-partial-sexp (point) (point-max) | 337 (st (perl-quote-syntax-table char))) |
327 nil nil state 'syntax-table))) | 338 (if (not close) |
328 ;; The open/close chars are matched like () [] {} and <>. | 339 ;; The closing char is the same as the opening char. |
329 (let ((parse-sexp-lookup-properties nil)) | 340 (with-syntax-table st |
330 (ignore-errors | 341 (parse-partial-sexp (point) (point-max) |
331 (with-syntax-table st | 342 nil nil state 'syntax-table) |
332 (goto-char (nth 8 state)) (forward-sexp 1)) | 343 (when twoargs |
333 (when twoargs | 344 (parse-partial-sexp (point) (point-max) |
334 (save-excursion | 345 nil nil state 'syntax-table))) |
335 ;; Skip whitespace and make sure that font-lock will | 346 ;; The open/close chars are matched like () [] {} and <>. |
336 ;; refontify the second part in the proper context. | 347 (let ((parse-sexp-lookup-properties nil)) |
337 (put-text-property | 348 (condition-case err |
338 (point) (progn (forward-comment (point-max)) (point)) | 349 (progn |
339 'font-lock-multiline t) | 350 (with-syntax-table st |
340 ;; | 351 (goto-char (nth 8 state)) (forward-sexp 1)) |
341 (unless | 352 (when twoargs |
342 (save-excursion | 353 (save-excursion |
343 (let* ((char2 (char-after)) | 354 ;; Skip whitespace and make sure that font-lock will |
344 (st2 (perl-quote-syntax-table char2))) | 355 ;; refontify the second part in the proper context. |
345 (with-syntax-table st2 (forward-sexp 1)) | 356 (put-text-property |
346 (put-text-property pos (line-end-position) | 357 (point) (progn (forward-comment (point-max)) (point)) |
347 'jit-lock-defer-multiline t) | 358 'font-lock-multiline t) |
348 (looking-at "\\s-*\\sw*e"))) | 359 ;; |
349 (put-text-property (point) (1+ (point)) | 360 (unless |
350 'syntax-table | 361 (save-excursion |
351 (if (assoc (char-after) | 362 (with-syntax-table |
352 perl-quote-like-pairs) | 363 (perl-quote-syntax-table (char-after)) |
353 '(15) '(7))))))))) | 364 (forward-sexp 1)) |
354 ;; Erase any syntactic marks within the quoted text. | 365 (put-text-property pos (line-end-position) |
355 (put-text-property pos (1- (point)) 'syntax-table nil) | 366 'jit-lock-defer-multiline t) |
356 (when (eq (char-before (1- (point))) ?$) | 367 (looking-at "\\s-*\\sw*e")) |
357 (put-text-property (- (point) 2) (1- (point)) | 368 (put-text-property (point) (1+ (point)) |
358 'syntax-table '(1))) | 369 'syntax-table |
359 (put-text-property (1- (point)) (point) | 370 (if (assoc (char-after) |
360 'syntax-table (if close '(15) '(7))) | 371 perl-quote-like-pairs) |
361 font-lock-string-face)))))) | 372 '(15) '(7))))))) |
362 ;; (if (or twoargs (not (looking-at "\\s-*\\sw*e"))) | 373 ;; The arg(s) is not terminated, so it extends until EOB. |
363 ;; font-lock-string-face | 374 (scan-error (goto-char (point-max)))))) |
364 ;; (font-lock-fontify-syntactically-region | 375 ;; Point is now right after the arg(s). |
365 ;; ;; FIXME: `end' is accessed via dyn-scoping. | 376 ;; Erase any syntactic marks within the quoted text. |
366 ;; pos (min end (1- (point))) nil '(nil)) | 377 (put-text-property pos (1- (point)) 'syntax-table nil) |
367 ;; nil))))))) | 378 (when (eq (char-before (1- (point))) ?$) |
379 (put-text-property (- (point) 2) (1- (point)) | |
380 'syntax-table '(1))) | |
381 (put-text-property (1- (point)) (point) | |
382 'syntax-table (if close '(15) '(7))))))) | |
383 | |
384 (setq state (parse-partial-sexp (point) limit nil nil state | |
385 'syntax-table)))) | |
386 ;; Tell font-lock that this needs not further processing. | |
387 nil) | |
368 | 388 |
369 | 389 |
370 (defcustom perl-indent-level 4 | 390 (defcustom perl-indent-level 4 |
371 "*Indentation of Perl statements with respect to containing block." | 391 "*Indentation of Perl statements with respect to containing block." |
372 :type 'integer | 392 :type 'integer |
396 "*If non-nil offset of argument lines relative to usual indentation. | 416 "*If non-nil offset of argument lines relative to usual indentation. |
397 If nil, continued arguments are aligned with the first argument." | 417 If nil, continued arguments are aligned with the first argument." |
398 :type '(choice integer (const nil)) | 418 :type '(choice integer (const nil)) |
399 :group 'perl) | 419 :group 'perl) |
400 | 420 |
401 (defcustom perl-tab-always-indent t | 421 (defcustom perl-tab-always-indent tab-always-indent |
402 "*Non-nil means TAB in Perl mode always indents the current line. | 422 "Non-nil means TAB in Perl mode always indents the current line. |
403 Otherwise it inserts a tab character if you type it past the first | 423 Otherwise it inserts a tab character if you type it past the first |
404 nonwhite character on the line." | 424 nonwhite character on the line." |
405 :type 'boolean | 425 :type 'boolean |
406 :group 'perl) | 426 :group 'perl) |
407 | 427 |
413 existing comment, moves to end-of-line, or if at end-of-line already, | 433 existing comment, moves to end-of-line, or if at end-of-line already, |
414 create a new comment." | 434 create a new comment." |
415 :type 'boolean | 435 :type 'boolean |
416 :group 'perl) | 436 :group 'perl) |
417 | 437 |
418 (defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:" | 438 (defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]" |
419 "*Lines starting with this regular expression are not auto-indented." | 439 "*Lines starting with this regular expression are not auto-indented." |
420 :type 'regexp | 440 :type 'regexp |
421 :group 'perl) | 441 :group 'perl) |
442 | |
443 ;; Outline support | |
444 | |
445 (defvar perl-outline-regexp | |
446 (concat (mapconcat 'cadr perl-imenu-generic-expression "\\|") | |
447 "\\|^=cut\\>")) | |
448 | |
449 (defun perl-outline-level () | |
450 (cond | |
451 ((looking-at "package\\s-") 0) | |
452 ((looking-at "sub\\s-") 1) | |
453 ((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0)) | |
454 ((looking-at "=cut") 1) | |
455 (t 3))) | |
422 | 456 |
457 (defvar perl-mode-hook nil | |
458 "Normal hook to run when entering Perl mode.") | |
459 | |
423 ;;;###autoload | 460 ;;;###autoload |
424 (defun perl-mode () | 461 (defun perl-mode () |
425 "Major mode for editing Perl code. | 462 "Major mode for editing Perl code. |
426 Expression and list commands understand all Perl brackets. | 463 Expression and list commands understand all Perl brackets. |
427 Tab indents for Perl code. | 464 Tab indents for Perl code. |
482 (make-local-variable 'paragraph-ignore-fill-prefix) | 519 (make-local-variable 'paragraph-ignore-fill-prefix) |
483 (setq paragraph-ignore-fill-prefix t) | 520 (setq paragraph-ignore-fill-prefix t) |
484 (make-local-variable 'indent-line-function) | 521 (make-local-variable 'indent-line-function) |
485 (setq indent-line-function 'perl-indent-line) | 522 (setq indent-line-function 'perl-indent-line) |
486 (make-local-variable 'require-final-newline) | 523 (make-local-variable 'require-final-newline) |
487 (setq require-final-newline t) | 524 (setq require-final-newline mode-require-final-newline) |
488 (make-local-variable 'comment-start) | 525 (make-local-variable 'comment-start) |
489 (setq comment-start "# ") | 526 (setq comment-start "# ") |
490 (make-local-variable 'comment-end) | 527 (make-local-variable 'comment-end) |
491 (setq comment-end "") | 528 (setq comment-end "") |
492 (make-local-variable 'comment-start-skip) | 529 (make-local-variable 'comment-start-skip) |
500 perl-font-lock-keywords-1 | 537 perl-font-lock-keywords-1 |
501 perl-font-lock-keywords-2) | 538 perl-font-lock-keywords-2) |
502 nil nil ((?\_ . "w")) nil | 539 nil nil ((?\_ . "w")) nil |
503 (font-lock-syntactic-keywords | 540 (font-lock-syntactic-keywords |
504 . perl-font-lock-syntactic-keywords) | 541 . perl-font-lock-syntactic-keywords) |
505 (font-lock-syntactic-face-function | |
506 . perl-font-lock-syntactic-face-function) | |
507 (parse-sexp-lookup-properties . t))) | 542 (parse-sexp-lookup-properties . t))) |
508 ;; Tell imenu how to handle Perl. | 543 ;; Tell imenu how to handle Perl. |
509 (make-local-variable 'imenu-generic-expression) | 544 (set (make-local-variable 'imenu-generic-expression) |
510 (setq imenu-generic-expression perl-imenu-generic-expression) | 545 perl-imenu-generic-expression) |
511 (setq imenu-case-fold-search nil) | 546 (setq imenu-case-fold-search nil) |
512 (run-hooks 'perl-mode-hook)) | 547 ;; Setup outline-minor-mode. |
548 (set (make-local-variable 'outline-regexp) perl-outline-regexp) | |
549 (set (make-local-variable 'outline-level) 'perl-outline-level) | |
550 (run-mode-hooks 'perl-mode-hook)) | |
513 | 551 |
514 ;; This is used by indent-for-comment | 552 ;; This is used by indent-for-comment |
515 ;; to decide how much to indent a comment in Perl code | 553 ;; to decide how much to indent a comment in Perl code |
516 ;; based on its context. | 554 ;; based on its context. |
517 (defun perl-comment-indent () | 555 (defun perl-comment-indent () |
634 (cond ((eq (char-after bof) ?=) 0) | 672 (cond ((eq (char-after bof) ?=) 0) |
635 ((listp (setq indent (perl-calculate-indent bof))) indent) | 673 ((listp (setq indent (perl-calculate-indent bof))) indent) |
636 ((looking-at (or nochange perl-nochange)) 0) | 674 ((looking-at (or nochange perl-nochange)) 0) |
637 (t | 675 (t |
638 (skip-chars-forward " \t\f") | 676 (skip-chars-forward " \t\f") |
639 (cond ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") | 677 (setq indent (perl-indent-new-calculate nil indent bof)) |
640 (setq indent (max 1 (+ indent perl-label-offset)))) | |
641 ((= (char-syntax (following-char)) ?\)) | |
642 (setq indent | |
643 (save-excursion | |
644 (forward-char 1) | |
645 (forward-sexp -1) | |
646 (forward-char 1) | |
647 (if (perl-hanging-paren-p) | |
648 (- indent perl-indent-level) | |
649 (forward-char -1) | |
650 (current-column))))) | |
651 ((= (following-char) ?{) | |
652 (setq indent (+ indent perl-brace-offset)))) | |
653 (- indent (current-column))))) | 678 (- indent (current-column))))) |
654 (skip-chars-forward " \t\f") | 679 (skip-chars-forward " \t\f") |
655 (if (and (numberp shift-amt) (/= 0 shift-amt)) | 680 (if (and (numberp shift-amt) (/= 0 shift-amt)) |
656 (progn (delete-region beg (point)) | 681 (progn (delete-region beg (point)) |
657 (indent-to indent))) | 682 (indent-to indent))) |
683 "Non-nil if we are right after a hanging parenthesis-like char." | 708 "Non-nil if we are right after a hanging parenthesis-like char." |
684 (and (looking-at "[ \t]*$") | 709 (and (looking-at "[ \t]*$") |
685 (save-excursion | 710 (save-excursion |
686 (skip-syntax-backward " (") (not (bolp))))) | 711 (skip-syntax-backward " (") (not (bolp))))) |
687 | 712 |
713 (defun perl-indent-new-calculate (&optional virtual default parse-start) | |
714 (or | |
715 (and virtual (save-excursion (skip-chars-backward " \t") (bolp)) | |
716 (current-column)) | |
717 (and (looking-at "\\(\\w\\|\\s_\\)+:[^:]") | |
718 (max 1 (+ (or default (perl-calculate-indent parse-start)) | |
719 perl-label-offset))) | |
720 (and (= (char-syntax (following-char)) ?\)) | |
721 (save-excursion | |
722 (forward-char 1) | |
723 (forward-sexp -1) | |
724 (perl-indent-new-calculate 'virtual nil parse-start))) | |
725 (and (and (= (following-char) ?{) | |
726 (save-excursion (forward-char) (perl-hanging-paren-p))) | |
727 (+ (or default (perl-calculate-indent parse-start)) | |
728 perl-brace-offset)) | |
729 (or default (perl-calculate-indent parse-start)))) | |
730 | |
688 (defun perl-calculate-indent (&optional parse-start) | 731 (defun perl-calculate-indent (&optional parse-start) |
689 "Return appropriate indentation for current line as Perl code. | 732 "Return appropriate indentation for current line as Perl code. |
690 In usual case returns an integer: the column to indent to. | 733 In usual case returns an integer: the column to indent to. |
691 Returns (parse-state) if line starts inside a string. | 734 Returns (parse-state) if line starts inside a string. |
692 Optional argument PARSE-START should be the position of `beginning-of-defun'." | 735 Optional argument PARSE-START should be the position of `beginning-of-defun'." |
693 (save-excursion | 736 (save-excursion |
694 (beginning-of-line) | |
695 (let ((indent-point (point)) | 737 (let ((indent-point (point)) |
696 (case-fold-search nil) | 738 (case-fold-search nil) |
697 (colon-line-end 0) | 739 (colon-line-end 0) |
698 state containing-sexp) | 740 state containing-sexp) |
699 (if parse-start ;used to avoid searching | 741 (if parse-start ;used to avoid searching |
775 ;; Skip over comments and labels following openbrace. | 817 ;; Skip over comments and labels following openbrace. |
776 (while (progn | 818 (while (progn |
777 (skip-chars-forward " \t\f\n") | 819 (skip-chars-forward " \t\f\n") |
778 (cond ((looking-at ";?#") | 820 (cond ((looking-at ";?#") |
779 (forward-line 1) t) | 821 (forward-line 1) t) |
780 ((looking-at "\\(\\w\\|\\s_\\)+:") | 822 ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") |
781 (save-excursion | 823 (save-excursion |
782 (end-of-line) | 824 (end-of-line) |
783 (setq colon-line-end (point))) | 825 (setq colon-line-end (point))) |
784 (search-forward ":"))))) | 826 (search-forward ":"))))) |
785 ;; The first following code counts | 827 ;; The first following code counts |
891 With argument, repeat that many times; negative args move backward." | 933 With argument, repeat that many times; negative args move backward." |
892 (interactive "p") | 934 (interactive "p") |
893 (or arg (setq arg 1)) | 935 (or arg (setq arg 1)) |
894 (let ((first t)) | 936 (let ((first t)) |
895 (while (and (> arg 0) (< (point) (point-max))) | 937 (while (and (> arg 0) (< (point) (point-max))) |
896 (let ((pos (point)) npos) | 938 (let ((pos (point))) |
897 (while (progn | 939 (while (progn |
898 (if (and first | 940 (if (and first |
899 (progn | 941 (progn |
900 (forward-char 1) | 942 (forward-char 1) |
901 (perl-beginning-of-function 1) | 943 (perl-beginning-of-function 1) |
935 (perl-beginning-of-function) | 977 (perl-beginning-of-function) |
936 (backward-paragraph)) | 978 (backward-paragraph)) |
937 | 979 |
938 (provide 'perl-mode) | 980 (provide 'perl-mode) |
939 | 981 |
982 ;; arch-tag: 8c7ff68d-15f3-46a2-ade2-b7c41f176826 | |
940 ;;; perl-mode.el ends here | 983 ;;; perl-mode.el ends here |