comparison lisp/progmodes/perl-mode.el @ 66638:4ac8c6441408

(perl-font-lock-special-syntactic-constructs): Rename from perl-font-lock-syntactic-face-function. Change the calling convention so it can be used as a font-lock MATCHER. Do the parse-partial-sexp loop outselves. (perl-font-lock-syntactic-keywords): Use it. (perl-mode): Don't set font-lock-syntactic-face-function any more.

66637:7567f8b4780e

;; tr /.../.../
;; y /.../.../
;;
;; <file*glob>
(defvar perl-font-lock-syntactic-keywords
  ;; Turn POD into b-style comments
  '(("^\\(=\\)\\sw" (1 "< b"))
    ("^=cut[ \t]*\\(\n\\)" (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 ". p"))

     ;; \s (appears often in regexps).
     ;; -s file
     (3 (if (assoc (char-after (match-beginning 3))
		   perl-quote-like-pairs)
	    '(15) '(7))))
    ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
    ))

(defvar perl-empty-syntax-table
  (let ((st (copy-syntax-table)))
    ;; Make all chars be of punctuation syntax.

	(modify-syntax-entry char "\"" st)
      (modify-syntax-entry char "(" st)
      (modify-syntax-entry close ")" st))
    st))

(defun perl-font-lock-syntactic-face-function (state)
  (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))
	      (condition-case err
		  (progn
		    (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
			      (with-syntax-table
				  (perl-quote-syntax-table (char-after))
				(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)))))))
		;; The arg(s) is not terminated, so it extends until EOB.
		(scan-error (goto-char (point-max))))))
	  ;; Point is now right after the arg(s).
	  ;; 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."
  :type 'integer

			      perl-font-lock-keywords-1
			      perl-font-lock-keywords-2)
			     nil nil ((?\_ . "w")) nil
			     (font-lock-syntactic-keywords
			      . perl-font-lock-syntactic-keywords)
			     (font-lock-syntactic-face-function
			      . perl-font-lock-syntactic-face-function)
			     (parse-sexp-lookup-properties . t)))
  ;; Tell imenu how to handle Perl.
  (set (make-local-variable 'imenu-generic-expression)
       perl-imenu-generic-expression)
  (setq imenu-case-fold-search nil)

66638:4ac8c6441408

;; tr /.../.../
;; y /.../.../
;;
;; <file*glob>
(defvar perl-font-lock-syntactic-keywords
  ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
  '(;; Turn POD into b-style comments
    ("^\\(=\\)\\sw" (1 "< b"))
    ("^=cut[ \t]*\\(\n\\)" (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 ". p"))

     ;; \s (appears often in regexps).
     ;; -s file
     (3 (if (assoc (char-after (match-beginning 3))
		   perl-quote-like-pairs)
	    '(15) '(7))))
    ;; Find and mark the end of funny quotes and format statements.
    (perl-font-lock-special-syntactic-constructs)
    ))

(defvar perl-empty-syntax-table
  (let ((st (copy-syntax-table)))
    ;; Make all chars be of punctuation syntax.

	(modify-syntax-entry char "\"" st)
      (modify-syntax-entry char "(" st)
      (modify-syntax-entry close ")" st))
    st))

(defun perl-font-lock-special-syntactic-constructs (limit)
  ;; We used to do all this in a font-lock-syntactic-face-function, which
  ;; did not work correctly because sometimes some parts of the buffer are
  ;; treated with font-lock-syntactic-keywords but not with
  ;; font-lock-syntactic-face-function (mostly because of
  ;; font-lock-syntactically-fontified).  That meant that some syntax-table
  ;; properties were missing.  So now we do the parse-partial-sexp loop
  ;; ourselves directly from font-lock-syntactic-keywords, so we're sure
  ;; it's done when necessary.
  (let ((state (syntax-ppss))
        char)
    (while (< (point) limit)
      (cond
       ((or (null (setq char (nth 3 state)))
            (and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")))
        ;; Normal text, or comment, or docstring, or normal string.
        nil)
       ((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)))))
       (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))
                (condition-case err
                    (progn
                      (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
                                (with-syntax-table
                                    (perl-quote-syntax-table (char-after))
                                  (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)))))))
                  ;; The arg(s) is not terminated, so it extends until EOB.
                  (scan-error (goto-char (point-max))))))
            ;; Point is now right after the arg(s).
            ;; 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)))))))

      (setq state (parse-partial-sexp (point) limit nil nil state
				      'syntax-table))))
  ;; Tell font-lock that this needs not further processing.
  nil)


(defcustom perl-indent-level 4
  "*Indentation of Perl statements with respect to containing block."
  :type 'integer

			      perl-font-lock-keywords-1
			      perl-font-lock-keywords-2)
			     nil nil ((?\_ . "w")) nil
			     (font-lock-syntactic-keywords
			      . perl-font-lock-syntactic-keywords)
			     (parse-sexp-lookup-properties . t)))
  ;; Tell imenu how to handle Perl.
  (set (make-local-variable 'imenu-generic-expression)
       perl-imenu-generic-expression)
  (setq imenu-case-fold-search nil)