Function: perl-syntax-propertize-function
perl-syntax-propertize-function is a byte-compiled function defined in
perl-mode.el.gz.
Signature
(perl-syntax-propertize-function START END)
Source Code
;; Defined in /usr/src/emacs/lisp/progmodes/perl-mode.el.gz
(defun perl-syntax-propertize-function (start end)
(let ((case-fold-search nil))
(goto-char start)
(perl-syntax-propertize-special-constructs end)
(funcall
(syntax-propertize-rules
;; Turn POD into b-style comments. Place the cut rule first since it's
;; more specific.
("^=cut\\>.*\\(\n\\)" (1 "> b"))
("^\\(=\\)\\sw" (1 "< b"))
;; Catch ${ so that ${var} doesn't screw up indentation.
;; This also catches $' to handle 'foo$', although it should really
;; check that it occurs inside a '..' string.
("\\(\\$\\)[{']" (1 (unless (and (eq ?\' (char-after (match-end 1)))
(save-excursion
(not (nth 3 (syntax-ppss
(match-beginning 0))))))
(string-to-syntax ". p"))))
;; If "\" is acting as a backslash operator, it shouldn't start an
;; escape sequence, so change its syntax. This allows us to handle
;; correctly the \() construct (Bug#11996) as well as references
;; to string values.
("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss))
(string-to-syntax "."))))
;; Handle funny names like $DB'stop.
("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
("^[ \t]*format.*=[ \t]*\\(\n\\)"
(1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
;; Propertize perl prototype chars `$%&*;+@\[]' as punctuation
;; in `sub' arg-specs like `sub myfun ($)' and `sub ($)'. But
;; don't match subroutine signatures like `sub add ($a, $b)', or
;; anonymous subs like "sub { (...) ... }".
("\\<sub\\(?:[\s\t\n]+\\(?:\\sw\\|\\s_\\)+\\)?[\s\t\n]*(\\([][$%&*;+@\\]+\\))"
(1 "."))
;; Turn __DATA__ trailer into a comment.
("^\\(_\\)_\\(?:DATA\\|END\\)__[ \t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)"
(1 "< c") (2 "> c")
(0 (ignore (put-text-property (match-beginning 0) (match-end 0)
'syntax-multiline t))))
;; Regexp and funny quotes. Distinguishing a / that starts a regexp
;; match from the division operator is ...interesting.
;; Basically, / is a regexp match if it's preceded by an infix operator
;; (or some similar separator), or by one of the special keywords
;; corresponding to builtin functions that can take their first arg
;; without parentheses. Of course, that presume we're looking at the
;; *opening* slash. We can afford to mismatch the closing ones
;; here, because they will be re-treated separately later in
;; perl-font-lock-special-syntactic-constructs.
((concat perl--syntax-exp-intro-regexp "\\(/\\)")
(2 (ignore
(if (and (match-end 1) ; / at BOL.
(save-excursion
(goto-char (match-end 1))
(forward-comment (- (point-max)))
(put-text-property (point) (match-end 2)
'syntax-multiline t)
(not (or (and (eq ?w (char-syntax (preceding-char)))
(let ((end (point)))
(backward-sexp 1)
(member (buffer-substring (point) end)
perl--syntax-exp-intro-keywords)))
(bobp)
(memq (char-before)
'(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))))
nil ;; A division sign instead of a regexp-match.
(put-text-property (match-beginning 2) (match-end 2)
'syntax-table (string-to-syntax "\""))
(perl-syntax-propertize-special-constructs end)))))
("\\(^\\|[?:.,;=|&!~({[ \t]\\|=>\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\(?:\\s-\\|\n\\)*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)"
;; Nasty cases:
;; /foo/m $a->m $#m $m @m %m
;; \s (appears often in regexps).
;; -s file
;; y => 3
;; sub tr {...}
(3 (ignore
(if (save-excursion (goto-char (match-beginning 0))
(forward-word-strictly -1)
(looking-at-p "sub[ \t\n]"))
;; This is defining a function.
nil
(unless (nth 8 (save-excursion (syntax-ppss (match-beginning 1))))
;; Don't add this syntax-table property if
;; within a string, which would misbehave in cases such as
;; $a = "foo y \"toto\" bar" where we'd end up changing the
;; syntax of the backslash and hence de-escaping the embedded
;; double quote.
(let* ((b3 (match-beginning 3))
(c (char-after b3)))
(put-text-property
b3 (match-end 3) 'syntax-table
(cond
((assoc c perl-quote-like-pairs)
(string-to-syntax "|"))
;; If the separator is a normal quote and the operation
;; only takes a single arg, then there's nothing
;; special to do.
((and (memq c '(?\" ?\'))
(memq (char-after (match-beginning 2)) '(?m ?q)))
nil)
(t
(string-to-syntax "\"")))))
(perl-syntax-propertize-special-constructs end))))))
;; Here documents.
((concat
"\\(?:"
;; << "EOF", << 'EOF', or << \EOF
"<<\\(~\\)?[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
;; disambiguate with the left-bitshift operator.
"\\|" perl--syntax-exp-intro-regexp "<<\\(?1:~\\)?\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
(4 (let* ((eol (match-beginning 4))
(st (get-text-property eol 'syntax-table))
(name (match-string 2))
(indented (match-beginning 1)))
(goto-char (match-end 2))
(if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
;; '<<' occurred in a string, or in a comment.
;; Leave the property of the newline unchanged.
st
;; Beware of `foo <<'BAR' #baz` because
;; the newline needs to start the here-doc
;; and can't be used to close the comment.
(let ((eol-state (save-excursion (syntax-ppss eol))))
(when (nth 4 eol-state)
(if (/= (1- eol) (nth 8 eol-state))
;; make the last char of the comment closing it
(put-text-property (1- eol) eol
'syntax-table (string-to-syntax ">"))
;; In `foo <<'BAR' #` the # is the last character
;; before eol and can't both open and close the
;; comment. Workaround: disguise the "#" as
;; whitespace and fontify it as a comment.
(put-text-property (1- eol) eol
'syntax-table (string-to-syntax "-"))
(put-text-property (1- eol) eol
'font-lock-face
'font-lock-comment-face))))
(cons (car (string-to-syntax "< c"))
;; Remember the names of heredocs found on this line.
(cons (cons (pcase (aref name 0)
(?\\ (substring name 1))
((or ?\" ?\' ?\`) (substring name 1 -1))
(_ name))
indented)
(cdr st)))))))
;; We don't call perl-syntax-propertize-special-constructs directly
;; from the << rule, because there might be other elements (between
;; the << and the \n) that need to be propertized.
("\\(?:$\\)\\s<"
(0 (ignore (perl-syntax-propertize-special-constructs end))))
)
(point) end)))