Commit d3627c47 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(perl-mode-syntax-table): Mark $, % and @

such that backward-sexp correctly skips them.
(perl-font-lock-keywords-2): Use regexp-opt.
(perl-font-lock-syntactic-keywords)
(perl-font-lock-syntactic-face-function): Better handle PODs.
Handle package names with ' in them and ($$) in `sub' declarations.
Handle format staements.  Handle regexp and quote-like ops.
(perl-empty-syntax-table): New var.
(perl-quote-syntax-table): New fun.
parent 595015bb
......@@ -66,22 +66,23 @@
;; Known problems (these are all caused by limitations in the Emacs Lisp
;; parsing routine (parse-partial-sexp), which was not designed for such
;; a rich language; writing a more suitable parser would be a big job):
;; 1) Regular expression delimiters do not act as quotes, so special
;; characters such as `'"#:;[](){} may need to be backslashed
;; in regular expressions and in both parts of s/// and tr///.
;; 2) The globbing syntax <pattern> is not recognized, so special
;; characters in the pattern string must be backslashed.
;; 3) The q, qq, and << quoting operators are not recognized; see below.
;; 3) The << quoting operators are not recognized; see below.
;; 5) To make '$' work correctly, $' is not recognized as a variable.
;; Use "$'" or $POSTMATCH instead.
;; 7) When ' (quote) is used as a package name separator, perl-mode
;; doesn't understand, and thinks it is seeing a quoted string.
;;
;; If you don't use font-lock, additional problems will appear:
;; 1) Regular expression delimiters do not act as quotes, so special
;; characters such as `'"#:;[](){} may need to be backslashed
;; in regular expressions and in both parts of s/// and tr///.
;; 4) The q and qq quoting operators are not recognized; see below.
;; 5) To make variables such a $' and $#array work, perl-mode treats
;; $ just like backslash, so '$' is not treated correctly.
;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an
;; unmatched }. See below.
;; 7) When ' (quote) is used as a package name separator, perl-mode
;; doesn't understand, and thinks it is seeing a quoted string.
;; Here are some ugly tricks to bypass some of these problems: the perl
;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
......@@ -91,6 +92,11 @@
;;
;; /`/; $ugly = q?"'$?; /`/;
;;
;; The same trick can be used for problem 6 as in:
;; /{/; while (<${glob_me}>)
;; but a simpler solution is to add a space between the $ and the {:
;; while (<$ {glob_me}>)
;;
;; Problem 7 is even worse, but this 'fix' does work :-(
;; $DB'stop#'
;; [$DB'line#'
......@@ -133,8 +139,9 @@ The expansion is entirely correct because it uses the C preprocessor."
(let ((st (make-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?\n ">" st)
(modify-syntax-entry ?# "<" st)
(modify-syntax-entry ?$ "/" st)
(modify-syntax-entry ?% "." st)
(modify-syntax-entry ?$ "/ p" st)
(modify-syntax-entry ?% ". p" st)
(modify-syntax-entry ?@ ". p" st)
(modify-syntax-entry ?& "." st)
(modify-syntax-entry ?\' "\"" st)
(modify-syntax-entry ?* "." st)
......@@ -187,14 +194,11 @@ The expansion is entirely correct because it uses the C preprocessor."
(list
;;
;; Fontify keywords, except those fontified otherwise.
; (make-regexp '("if" "until" "while" "elsif" "else" "unless" "do" "dump"
; "for" "foreach" "exit" "die"
; "BEGIN" "END" "return" "exec" "eval"))
(concat "\\<\\("
"BEGIN\\|END\\|d\\(ie\\|o\\|ump\\)\\|"
"e\\(ls\\(e\\|if\\)\\|val\\|x\\(ec\\|it\\)\\)\\|"
"for\\(\\|each\\)\\|if\\|return\\|un\\(less\\|til\\)\\|while"
"\\)\\>")
(concat "\\<"
(regexp-opt '("if" "until" "while" "elsif" "else" "unless"
"do" "dump" "for" "foreach" "exit" "die"
"BEGIN" "END" "return" "exec" "eval") t)
"\\>")
;;
;; Fontify local and my keywords as types.
'("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
......@@ -217,17 +221,149 @@ The expansion is entirely correct because it uses the C preprocessor."
(defvar perl-font-lock-keywords perl-font-lock-keywords-1
"Default expressions to highlight in Perl mode.")
(defvar perl-quote-like-pairs
'((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>)))
;; FIXME: handle here-docs and regexps.
;; <<EOF <<"EOF" <<'EOF' (no space)
;; see `man perlop'
;; ?...?
;; /.../
;; m [...]
;; m /.../
;; q /.../ = '...'
;; qq /.../ = "..."
;; qx /.../ = `...`
;; qr /.../ = precompiled regexp =~=~ m/.../
;; qw /.../
;; s /.../.../
;; s <...> /.../
;; s '...'...'
;; tr /.../.../
;; y /.../.../
;;
;; <file*glob>
(defvar perl-font-lock-syntactic-keywords
;; Turn POD into b-style comments
'(("^\\(=\\)\\(head1\\|pod\\)\\([ \t]\\|$\\)" (1 "< b"))
'(("^\\(=\\)\\sw" (1 "< b"))
("^=cut[ \t]*\\(\n\\)" (1 "> b"))
;; Catch ${ so that ${var} doesn't screw up indentation.
("\\(\\$\\)[{']" (1 "."))))
;; This also catches $' to handle 'foo$', although it should really
;; check that it occurs inside a '..' string.
("\\(\\$\\)[{']" (1 "."))
;; Handle funny names like $DB'stop.
("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
;; format statements
("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7)))
;; Funny things in sub arg specifications like `sub myfunc ($$)'
("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1))
;; regexp and funny quotes
("[;(=!~{][ \t\n]*\\(/\\)" (1 '(7)))
("[;( =!~{\t\n]\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
;; Nasty cases:
;; /foo/m $a->m $#m $m @m %m
;; \s (appears often in regexps).
;; -s file
(2 (if (assoc (char-after (match-beginning 2))
perl-quote-like-pairs)
'(15) '(7))))))
(defvar perl-empty-syntax-table
(let ((st (copy-syntax-table)))
;; Make all chars be of punctuation syntax.
(dotimes (i 256) (aset st i '(1)))
(modify-syntax-entry ?\\ "\\" st)
st)
"Syntax table used internally for processing quote-like operators.")
(defun perl-quote-syntax-table (char)
(let ((close (cdr (assq char perl-quote-like-pairs)))
(st (copy-syntax-table perl-empty-syntax-table)))
(if (not close)
(modify-syntax-entry char "\"" st)
(modify-syntax-entry char "(" st)
(modify-syntax-entry close ")" st))
st))
(defun perl-font-lock-syntactic-face-function (state)
(if (nth 3 state)
font-lock-string-face
(if (nth 7 state) font-lock-doc-face font-lock-comment-face)))
(let ((char (nth 3 state)))
(cond
((not char)
;; Comment or docstring.
(if (nth 7 state) font-lock-doc-face font-lock-comment-face))
((and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\"))
;; Normal string.
font-lock-string-face)
((eq (nth 3 state) ?\n)
;; A `format' command.
(save-excursion
(when (and (re-search-forward "^\\s *\\.\\s *$" nil t)
(not (eobp)))
(put-text-property (point) (1+ (point)) 'syntax-table '(7)))
font-lock-string-face))
(t
;; This is regexp like quote thingy.
(setq char (char-after (nth 8 state)))
(save-excursion
(let ((twoargs (save-excursion
(goto-char (nth 8 state))
(skip-syntax-backward " ")
(skip-syntax-backward "w")
(member (buffer-substring
(point) (progn (forward-word 1) (point)))
'("tr" "s" "y"))))
(close (cdr (assq char perl-quote-like-pairs)))
(pos (point))
(st (perl-quote-syntax-table char)))
(if (not close)
;; The closing char is the same as the opening char.
(with-syntax-table st
(parse-partial-sexp (point) (point-max)
nil nil state 'syntax-table)
(when twoargs
(parse-partial-sexp (point) (point-max)
nil nil state 'syntax-table)))
;; The open/close chars are matched like () [] {} and <>.
(let ((parse-sexp-lookup-properties nil))
(ignore-errors
(with-syntax-table st
(goto-char (nth 8 state)) (forward-sexp 1))
(when twoargs
(save-excursion
;; Skip whitespace and make sure that font-lock will
;; refontify the second part in the proper context.
(put-text-property
(point) (progn (forward-comment (point-max)) (point))
'font-lock-multiline t)
;;
(unless
(save-excursion
(let* ((char2 (char-after))
(st2 (perl-quote-syntax-table char2)))
(with-syntax-table st2 (forward-sexp 1))
(put-text-property pos (line-end-position)
'jit-lock-defer-multiline t)
(looking-at "\\s-*\\sw*e")))
(put-text-property (point) (1+ (point))
'syntax-table
(if (assoc (char-after)
perl-quote-like-pairs)
'(15) '(7)))))))))
;; Erase any syntactic marks within the quoted text.
(put-text-property pos (1- (point)) 'syntax-table nil)
(when (eq (char-before (1- (point))) ?$)
(put-text-property (- (point) 2) (1- (point))
'syntax-table '(1)))
(put-text-property (1- (point)) (point)
'syntax-table (if close '(15) '(7)))
font-lock-string-face))))))
;; (if (or twoargs (not (looking-at "\\s-*\\sw*e")))
;; font-lock-string-face
;; (font-lock-fontify-syntactically-region
;; ;; FIXME: `end' is accessed via dyn-scoping.
;; pos (min end (1- (point))) nil '(nil))
;; nil)))))))
(defcustom perl-indent-level 4
"*Indentation of Perl statements with respect to containing block."
......@@ -536,7 +672,8 @@ changed by, or (parse-state) if line starts in a quoted string."
(defun perl-calculate-indent (&optional parse-start)
"Return appropriate indentation for current line as Perl code.
In usual case returns an integer: the column to indent to.
Returns (parse-state) if line starts inside a string."
Returns (parse-state) if line starts inside a string.
Optional argument PARSE-START should be the position of `beginning-of-defun'."
(save-excursion
(beginning-of-line)
(let ((indent-point (point))
......@@ -557,16 +694,16 @@ Returns (parse-state) if line starts inside a string."
(perl-beginning-of-function))
(while (< (point) indent-point) ;repeat until right sexp
(setq state (parse-partial-sexp (point) indent-point 0))
; state = (depth_in_parens innermost_containing_list last_complete_sexp
; string_terminator_or_nil inside_commentp following_quotep
; minimum_paren-depth_this_scan)
; Parsing stops if depth in parentheses becomes equal to third arg.
;; state = (depth_in_parens innermost_containing_list
;; last_complete_sexp string_terminator_or_nil inside_commentp
;; following_quotep minimum_paren-depth_this_scan)
;; Parsing stops if depth in parentheses becomes equal to third arg.
(setq containing-sexp (nth 1 state)))
(cond ((nth 3 state) state) ; In a quoted string?
((null containing-sexp) ; Line is at top level.
(skip-chars-forward " \t\f")
(if (= (following-char) ?{)
0 ; move to beginning of line if it starts a function body
0 ; move to beginning of line if it starts a function body
;; indent a little if this is a continuation line
(perl-backward-to-noncomment)
(if (or (bobp)
......@@ -609,50 +746,50 @@ Returns (parse-state) if line starts inside a string."
;; Is line first statement after an open-brace?
;; If no, find that first statement and indent like it.
(save-excursion
(forward-char 1)
;; Skip over comments and labels following openbrace.
(while (progn
(skip-chars-forward " \t\f\n")
(cond ((looking-at ";?#")
(forward-line 1) t)
((looking-at "\\(\\w\\|\\s_\\)+:")
(save-excursion
(end-of-line)
(setq colon-line-end (point)))
(search-forward ":")))))
;; The first following code counts
;; if it is before the line we want to indent.
(and (< (point) indent-point)
(if (> colon-line-end (point))
(- (current-indentation) perl-label-offset)
(current-column))))
;; If no previous statement,
;; indent it relative to line brace is on.
;; For open paren in column zero, don't let statement
;; start there too. If perl-indent-level is zero,
;; use perl-brace-offset + perl-continued-statement-offset
;; For open-braces not the first thing in a line,
;; add in perl-brace-imaginary-offset.
(+ (if (and (bolp) (zerop perl-indent-level))
(+ perl-brace-offset perl-continued-statement-offset)
perl-indent-level)
;; Move back over whitespace before the openbrace.
;; If openbrace is not first nonwhite thing on the line,
;; add the perl-brace-imaginary-offset.
(progn (skip-chars-backward " \t")
(if (bolp) 0 perl-brace-imaginary-offset))
;; If the openbrace is preceded by a parenthesized exp,
;; move to the beginning of that;
;; possibly a different line
(progn
(if (eq (preceding-char) ?\))
(forward-sexp -1))
;; Get initial indentation of the line we are on.
(current-indentation))))))))))
(forward-char 1)
;; Skip over comments and labels following openbrace.
(while (progn
(skip-chars-forward " \t\f\n")
(cond ((looking-at ";?#")
(forward-line 1) t)
((looking-at "\\(\\w\\|\\s_\\)+:")
(save-excursion
(end-of-line)
(setq colon-line-end (point)))
(search-forward ":")))))
;; The first following code counts
;; if it is before the line we want to indent.
(and (< (point) indent-point)
(if (> colon-line-end (point))
(- (current-indentation) perl-label-offset)
(current-column))))
;; If no previous statement,
;; indent it relative to line brace is on.
;; For open paren in column zero, don't let statement
;; start there too. If perl-indent-level is zero,
;; use perl-brace-offset + perl-continued-statement-offset
;; For open-braces not the first thing in a line,
;; add in perl-brace-imaginary-offset.
(+ (if (and (bolp) (zerop perl-indent-level))
(+ perl-brace-offset perl-continued-statement-offset)
perl-indent-level)
;; Move back over whitespace before the openbrace.
;; If openbrace is not first nonwhite thing on the line,
;; add the perl-brace-imaginary-offset.
(progn (skip-chars-backward " \t")
(if (bolp) 0 perl-brace-imaginary-offset))
;; If the openbrace is preceded by a parenthesized exp,
;; move to the beginning of that;
;; possibly a different line
(progn
(if (eq (preceding-char) ?\))
(forward-sexp -1))
;; Get initial indentation of the line we are on.
(current-indentation))))))))))
(defun perl-backward-to-noncomment ()
"Move point backward to after the first non-white-space, skipping comments."
(interactive) ;why?? -stef
(interactive)
(forward-comment (- (point-max))))
(defun perl-backward-to-start-of-continued-exp (lim)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment