From a17f2323d9018fa312b6721fa7ea5744edc79039 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Wed, 23 Dec 2020 02:34:33 +0100 Subject: [PATCH] ; perl-mode: Display here-docs as strings instead of comments. * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Make HERE-doc start a generic string instead of a c-style comment. Handle the case where the line starting a HERE-doc ends with a comment. (perl--beginning-of-here-doc): New function. (perl-backward-to-noncomment-nonhere): New function. (perl-syntax-propertize-special-constructs): Make HERE-terminators end generic strings instead of c-style comments, using the new functions. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-heredocs): New test (30 should-forms) for various aspects of HERE-documents. Works for CPerl mode, and with the patch also for Perl mode. * test/lisp/progmodes/cperl-mode-resources/here-docs.pl: New file with test cases. --- lisp/progmodes/perl-mode.el | 56 +++++++-- .../cperl-mode-resources/here-docs.pl | 111 ++++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 29 +++++ 3 files changed, 187 insertions(+), 9 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/here-docs.pl diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index fd8a51b5a5..a961f723d5 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -324,14 +324,29 @@ perl-syntax-propertize-function ;; disambiguate with the left-bitshift operator. "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)" ".*\\(\n\\)") - (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table)) + (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 - (cons (car (string-to-syntax "< c")) + ;; Before changing the syntax to generic string, let's + ;; check whether we are in an end-of-line comment, and + ;; if so, cheat by shifting the comment markers one char + ;; to the left. + (when (nth 4 (save-excursion (syntax-ppss eol))) + (when (equal (car (syntax-after (1- eol))) + (car (string-to-syntax "<"))) + ;; yet another edge case: "#" is the last character + ;; in that line, so there's actually no comment. + (put-text-property (- eol 2) (1- eol) + 'syntax-table (string-to-syntax "<"))) + (put-text-property (1- eol) eol + 'syntax-table (string-to-syntax ">"))) + (cons (car (string-to-syntax "|")) ;; Remember the names of heredocs found on this line. (cons (cons (pcase (aref name 0) (?\\ (substring name 1)) @@ -342,7 +357,7 @@ perl-syntax-propertize-function ;; 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<" + ("\\(?:$\\)\\s|" (0 (ignore (perl-syntax-propertize-special-constructs end)))) ) (point) end))) @@ -364,12 +379,24 @@ perl-quote-syntax-table (modify-syntax-entry close ")" st)) st)) +(defun perl--beginning-of-here-doc (state) + "If STATE describes a here-document, return its start, else return nil." + ;; We need to distinguish here-docs from normal strings, and from + ;; quote-like constructs like q//. + (let ((in-string-p (nth 3 state)) + (string-start (nth 8 state))) + (and in-string-p + (= (syntax-class (syntax-after string-start)) 15) ; generic string + ;; here-doc strings have a syntax table cdr for the terminator(s) + (cdr-safe (get-text-property string-start 'syntax-table)) + string-start))) ; return the start position if all other tests are t + (defun perl-syntax-propertize-special-constructs (limit) "Propertize special constructs like regexps and formats." (let ((state (syntax-ppss)) char) (cond - ((eq 2 (nth 7 state)) + ((perl--beginning-of-here-doc state) ;; A Here document. (let ((names (cdr (get-text-property (nth 8 state) 'syntax-table)))) (when (cdr names) @@ -386,7 +413,7 @@ perl-syntax-propertize-special-constructs limit 'move)) (unless names (put-text-property (1- (point)) (point) 'syntax-table - (string-to-syntax "> c")))))) + (string-to-syntax "|")))))) ((or (null (setq char (nth 3 state))) (and (characterp char) (null (get-text-property (nth 8 state) 'syntax-table)))) @@ -910,14 +937,14 @@ perl-continuation-line-p "Move to end of previous line and return non-nil if continued." ;; Statement level. Is it a continuation or a new statement? ;; Find previous non-comment character. - (perl-backward-to-noncomment) + (perl-backward-to-noncomment-nonhere) ;; Back up over label lines, since they don't ;; affect whether our line is a continuation. (while (and (eq (preceding-char) ?:) (memq (char-syntax (char-after (- (point) 2))) '(?w ?_))) (beginning-of-line) - (perl-backward-to-noncomment)) + (perl-backward-to-noncomment-nonhere)) ;; Now we get the answer. (unless (memq (preceding-char) '(?\; ?\} ?\{)) (preceding-char))) @@ -959,7 +986,7 @@ perl-calculate-indent (state (syntax-ppss)) (containing-sexp (nth 1 state)) ;; Don't auto-indent in a quoted string or a here-document. - (unindentable (or (nth 3 state) (eq 2 (nth 7 state))))) + (unindentable (or (nth 3 state) (perl--beginning-of-here-doc state)))) (when (and (eq t (nth 3 state)) (save-excursion (goto-char (nth 8 state)) @@ -976,7 +1003,7 @@ perl-calculate-indent (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{))) 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) + (perl-backward-to-noncomment-nonhere) (if (or (bobp) (memq (preceding-char) '(?\; ?\}))) 0 perl-continued-statement-offset))) @@ -1076,6 +1103,17 @@ perl-backward-to-noncomment "Move point backward to after the first non-white-space, skipping comments." (forward-comment (- (point-max)))) +(defun perl-backward-to-noncomment-nonhere () + "Move point backward, skipping comments and here-docs." + ;; Comments can appear after a here-doc, but also at the end of the + ;; line containing the here-doc delimiter(s). + (forward-comment (- (point-max))) + (unless (equal (point) (point-min)) + (let ((here-start (perl--beginning-of-here-doc + (save-excursion (syntax-ppss (1- (point))))))) + (when here-start (goto-char here-start))) + (forward-comment (- (point-max))))) + (defun perl-backward-to-start-of-continued-exp () (while (let ((c (preceding-char))) diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl new file mode 100644 index 0000000000..39e4fe06ba --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl @@ -0,0 +1,111 @@ +use 5.020; + +=head1 NAME + +here-docs.pl - resource file for cperl-test-here-docs + +=head1 DESCRIPTION + +This file holds a couple of HERE documents, with a variety of normal +and edge cases. For a formatted view of this description, run: + + (cperl-perldoc "here-docs.pl") + +For each of the HERE documents, the following checks will done: + +=over 4 + +=item * + +All occurrences of the string "look-here" are fontified as +'font-lock-string-face. Note that we deliberately test the face, not +the syntax property: Users won't care for the syntax property, but +they see the face. Different implementations with different syntax +properties have been seen in the past. + +=item * + +Indentation of the line(s) containing "look-here" is 0, i.e. there are no +leading spaces. + +=item * + +Indentation of the following perl statement containing "indent" should +be 0 if the statement contains "noindent", and according to the mode's +continued-statement-offset otherwise. + +=back + +=cut + +# Prologue to make the test file valid without warnings + +my $text; +my $any; +my $indentation; +my $anywhere = 'back again'; + +=head1 The Tests + +=head2 Test Case 1 + +We have two HERE documents in one line with different quoting styles. + +=cut + +## test case + +$text = <<"HERE" . <<'THERE' . $any; +#look-here and +HERE +$tlook-here and +THERE + +my $noindent = "This should be left-justified"; + +=head2 Test case 2 + +A HERE document followed by a continuation line + +=cut + +## test case + +$text = <