252 |
;; |
;; |
253 |
;; <file*glob> |
;; <file*glob> |
254 |
(defvar perl-font-lock-syntactic-keywords |
(defvar perl-font-lock-syntactic-keywords |
255 |
;; Turn POD into b-style comments |
;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") |
256 |
'(("^\\(=\\)\\sw" (1 "< b")) |
'(;; Turn POD into b-style comments |
257 |
|
("^\\(=\\)\\sw" (1 "< b")) |
258 |
("^=cut[ \t]*\\(\n\\)" (1 "> b")) |
("^=cut[ \t]*\\(\n\\)" (1 "> b")) |
259 |
;; Catch ${ so that ${var} doesn't screw up indentation. |
;; Catch ${ so that ${var} doesn't screw up indentation. |
260 |
;; This also catches $' to handle 'foo$', although it should really |
;; This also catches $' to handle 'foo$', although it should really |
276 |
(3 (if (assoc (char-after (match-beginning 3)) |
(3 (if (assoc (char-after (match-beginning 3)) |
277 |
perl-quote-like-pairs) |
perl-quote-like-pairs) |
278 |
'(15) '(7)))) |
'(15) '(7)))) |
279 |
;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") |
;; Find and mark the end of funny quotes and format statements. |
280 |
|
(perl-font-lock-special-syntactic-constructs) |
281 |
)) |
)) |
282 |
|
|
283 |
(defvar perl-empty-syntax-table |
(defvar perl-empty-syntax-table |
297 |
(modify-syntax-entry close ")" st)) |
(modify-syntax-entry close ")" st)) |
298 |
st)) |
st)) |
299 |
|
|
300 |
(defun perl-font-lock-syntactic-face-function (state) |
(defun perl-font-lock-special-syntactic-constructs (limit) |
301 |
(let ((char (nth 3 state))) |
;; We used to do all this in a font-lock-syntactic-face-function, which |
302 |
(cond |
;; did not work correctly because sometimes some parts of the buffer are |
303 |
((not char) |
;; treated with font-lock-syntactic-keywords but not with |
304 |
;; Comment or docstring. |
;; font-lock-syntactic-face-function (mostly because of |
305 |
(if (nth 7 state) font-lock-doc-face font-lock-comment-face)) |
;; font-lock-syntactically-fontified). That meant that some syntax-table |
306 |
((and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")) |
;; properties were missing. So now we do the parse-partial-sexp loop |
307 |
;; Normal string. |
;; ourselves directly from font-lock-syntactic-keywords, so we're sure |
308 |
font-lock-string-face) |
;; it's done when necessary. |
309 |
((eq (nth 3 state) ?\n) |
(let ((state (syntax-ppss)) |
310 |
;; A `format' command. |
char) |
311 |
(save-excursion |
(while (< (point) limit) |
312 |
(when (and (re-search-forward "^\\s *\\.\\s *$" nil t) |
(cond |
313 |
(not (eobp))) |
((or (null (setq char (nth 3 state))) |
314 |
(put-text-property (point) (1+ (point)) 'syntax-table '(7))) |
(and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\"))) |
315 |
font-lock-string-face)) |
;; Normal text, or comment, or docstring, or normal string. |
316 |
(t |
nil) |
317 |
;; This is regexp like quote thingy. |
((eq (nth 3 state) ?\n) |
318 |
(setq char (char-after (nth 8 state))) |
;; A `format' command. |
319 |
(save-excursion |
(save-excursion |
320 |
(let ((twoargs (save-excursion |
(when (and (re-search-forward "^\\s *\\.\\s *$" nil t) |
321 |
(goto-char (nth 8 state)) |
(not (eobp))) |
322 |
(skip-syntax-backward " ") |
(put-text-property (point) (1+ (point)) 'syntax-table '(7))))) |
323 |
(skip-syntax-backward "w") |
(t |
324 |
(member (buffer-substring |
;; This is regexp like quote thingy. |
325 |
(point) (progn (forward-word 1) (point))) |
(setq char (char-after (nth 8 state))) |
326 |
'("tr" "s" "y")))) |
(save-excursion |
327 |
(close (cdr (assq char perl-quote-like-pairs))) |
(let ((twoargs (save-excursion |
328 |
(pos (point)) |
(goto-char (nth 8 state)) |
329 |
(st (perl-quote-syntax-table char))) |
(skip-syntax-backward " ") |
330 |
(if (not close) |
(skip-syntax-backward "w") |
331 |
;; The closing char is the same as the opening char. |
(member (buffer-substring |
332 |
(with-syntax-table st |
(point) (progn (forward-word 1) (point))) |
333 |
(parse-partial-sexp (point) (point-max) |
'("tr" "s" "y")))) |
334 |
nil nil state 'syntax-table) |
(close (cdr (assq char perl-quote-like-pairs))) |
335 |
(when twoargs |
(pos (point)) |
336 |
(parse-partial-sexp (point) (point-max) |
(st (perl-quote-syntax-table char))) |
337 |
nil nil state 'syntax-table))) |
(if (not close) |
338 |
;; The open/close chars are matched like () [] {} and <>. |
;; The closing char is the same as the opening char. |
339 |
(let ((parse-sexp-lookup-properties nil)) |
(with-syntax-table st |
340 |
(condition-case err |
(parse-partial-sexp (point) (point-max) |
341 |
(progn |
nil nil state 'syntax-table) |
342 |
(with-syntax-table st |
(when twoargs |
343 |
(goto-char (nth 8 state)) (forward-sexp 1)) |
(parse-partial-sexp (point) (point-max) |
344 |
(when twoargs |
nil nil state 'syntax-table))) |
345 |
(save-excursion |
;; The open/close chars are matched like () [] {} and <>. |
346 |
;; Skip whitespace and make sure that font-lock will |
(let ((parse-sexp-lookup-properties nil)) |
347 |
;; refontify the second part in the proper context. |
(condition-case err |
348 |
(put-text-property |
(progn |
349 |
(point) (progn (forward-comment (point-max)) (point)) |
(with-syntax-table st |
350 |
'font-lock-multiline t) |
(goto-char (nth 8 state)) (forward-sexp 1)) |
351 |
;; |
(when twoargs |
352 |
(unless |
(save-excursion |
353 |
(save-excursion |
;; Skip whitespace and make sure that font-lock will |
354 |
(with-syntax-table |
;; refontify the second part in the proper context. |
355 |
(perl-quote-syntax-table (char-after)) |
(put-text-property |
356 |
(forward-sexp 1)) |
(point) (progn (forward-comment (point-max)) (point)) |
357 |
(put-text-property pos (line-end-position) |
'font-lock-multiline t) |
358 |
'jit-lock-defer-multiline t) |
;; |
359 |
(looking-at "\\s-*\\sw*e")) |
(unless |
360 |
(put-text-property (point) (1+ (point)) |
(save-excursion |
361 |
'syntax-table |
(with-syntax-table |
362 |
(if (assoc (char-after) |
(perl-quote-syntax-table (char-after)) |
363 |
perl-quote-like-pairs) |
(forward-sexp 1)) |
364 |
'(15) '(7))))))) |
(put-text-property pos (line-end-position) |
365 |
;; The arg(s) is not terminated, so it extends until EOB. |
'jit-lock-defer-multiline t) |
366 |
(scan-error (goto-char (point-max)))))) |
(looking-at "\\s-*\\sw*e")) |
367 |
;; Point is now right after the arg(s). |
(put-text-property (point) (1+ (point)) |
368 |
;; Erase any syntactic marks within the quoted text. |
'syntax-table |
369 |
(put-text-property pos (1- (point)) 'syntax-table nil) |
(if (assoc (char-after) |
370 |
(when (eq (char-before (1- (point))) ?$) |
perl-quote-like-pairs) |
371 |
(put-text-property (- (point) 2) (1- (point)) |
'(15) '(7))))))) |
372 |
'syntax-table '(1))) |
;; The arg(s) is not terminated, so it extends until EOB. |
373 |
(put-text-property (1- (point)) (point) |
(scan-error (goto-char (point-max)))))) |
374 |
'syntax-table (if close '(15) '(7))) |
;; Point is now right after the arg(s). |
375 |
font-lock-string-face)))))) |
;; Erase any syntactic marks within the quoted text. |
376 |
;; (if (or twoargs (not (looking-at "\\s-*\\sw*e"))) |
(put-text-property pos (1- (point)) 'syntax-table nil) |
377 |
;; font-lock-string-face |
(when (eq (char-before (1- (point))) ?$) |
378 |
;; (font-lock-fontify-syntactically-region |
(put-text-property (- (point) 2) (1- (point)) |
379 |
;; ;; FIXME: `end' is accessed via dyn-scoping. |
'syntax-table '(1))) |
380 |
;; pos (min end (1- (point))) nil '(nil)) |
(put-text-property (1- (point)) (point) |
381 |
;; nil))))))) |
'syntax-table (if close '(15) '(7))))))) |
382 |
|
|
383 |
|
(setq state (parse-partial-sexp (point) limit nil nil state |
384 |
|
'syntax-table)))) |
385 |
|
;; Tell font-lock that this needs not further processing. |
386 |
|
nil) |
387 |
|
|
388 |
|
|
389 |
(defcustom perl-indent-level 4 |
(defcustom perl-indent-level 4 |
538 |
nil nil ((?\_ . "w")) nil |
nil nil ((?\_ . "w")) nil |
539 |
(font-lock-syntactic-keywords |
(font-lock-syntactic-keywords |
540 |
. perl-font-lock-syntactic-keywords) |
. perl-font-lock-syntactic-keywords) |
|
(font-lock-syntactic-face-function |
|
|
. perl-font-lock-syntactic-face-function) |
|
541 |
(parse-sexp-lookup-properties . t))) |
(parse-sexp-lookup-properties . t))) |
542 |
;; Tell imenu how to handle Perl. |
;; Tell imenu how to handle Perl. |
543 |
(set (make-local-variable 'imenu-generic-expression) |
(set (make-local-variable 'imenu-generic-expression) |