[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master a1887cc: ; cperl-mode.el: Fix border cases of inserting with elis
From: |
Harald Jörg |
Subject: |
master a1887cc: ; cperl-mode.el: Fix border cases of inserting with elisp |
Date: |
Mon, 30 Aug 2021 14:35:56 -0400 (EDT) |
branch: master
commit a1887cc5e6c63d89f8495148d32a6927f84f1571
Author: Harald Jörg <haj@posteo.de>
Commit: Harald Jörg <haj@posteo.de>
; cperl-mode.el: Fix border cases of inserting with elisp
* lisp/progmodes/cperl-mode.el (cperl-unwind-to-safe): Replace
(and extend) inline comment by a docstring. Handle edge cases when
inserting text with elisp (related to Bug#28962).
(cperl-process-here-doc): Add syntax-type `here-doc-start'.
(cperl-find-pods-heres): Make sure that the results of this
function are immediately visible.
* test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-14343):
Add test cases for "empty" here-documents and inserting at the
edges of a here-document.
---
lisp/progmodes/cperl-mode.el | 37 +++++++++++++++++++--
test/lisp/progmodes/cperl-mode-tests.el | 58 +++++++++++++++++++++++++++++----
2 files changed, 87 insertions(+), 8 deletions(-)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 727deab..f518501 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -3338,8 +3338,10 @@ Works before syntax recognition is done."
;; Each non-literal part is marked `syntax-type' ==> `pod'
;; Each literal part is marked `syntax-type' ==> `in-pod'
;; b) HEREs:
+;; The point before start is marked `here-doc-start'
;; Start-to-end is marked `here-doc-group' ==> t
;; The body is marked `syntax-type' ==> `here-doc'
+;; and is also marked as style 2 comment
;; The delimiter is marked `syntax-type' ==> `here-doc-delim'
;; c) FORMATs:
;; First line (to =) marked `first-format-line' ==> t
@@ -3356,8 +3358,36 @@ Works before syntax recognition is done."
;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise).
(defun cperl-unwind-to-safe (before &optional end)
- ;; if BEFORE, go to the previous start-of-line on each step of unwinding
- (let ((pos (point)))
+ "Move point back to a safe place, back up one extra line if BEFORE.
+A place is \"safe\" if it is not within POD, a here-document, a
+format, a quote-like expression, a subroutine attribute list or a
+multiline declaration. These places all have special syntactical
+rules and need to be parsed as a whole. If END, return the
+position of the end of the unsafe construct."
+ (let ((pos (point))
+ (state (syntax-ppss)))
+ ;; Check edge cases for here-documents first
+ (when before ; we need a safe start for parsing
+ (cond
+ ((or (equal (get-text-property (cperl-1- (point)) 'syntax-type)
+ 'here-doc-start)
+ (equal (syntax-after (cperl-1- (point)))
+ (string-to-syntax "> c")))
+ ;; point is either immediately after the start of a here-doc
+ ;; (which may consist of nothing but one newline) or
+ ;; immediately after the now-outdated end marker of the
+ ;; here-doc. In both cases we need to back up to the line
+ ;; where the here-doc delimiters are defined.
+ (forward-char -1)
+ (cperl-backward-to-noncomment (point-min))
+ (beginning-of-line))
+ ((eq 2 (nth 7 state))
+ ;; point is somewhere in a here-document. Back up to the line
+ ;; where the here-doc delimiters are defined.
+ (goto-char (nth 8 state)) ; beginning of this here-doc
+ (cperl-backward-to-noncomment ; skip back over more
+ (point-min)) ; here-documents (if any)
+ (beginning-of-line)))) ; skip back over here-doc starters
(while (and pos (progn
(beginning-of-line)
(get-text-property (setq pos (point)) 'syntax-type)))
@@ -3657,6 +3687,8 @@ This is part of `cperl-find-pods-heres' (below)."
;; the whole construct:
(put-text-property here-doc-start (cperl-1+ here-doc-start) 'front-sticky
'(syntax-type))
(cperl-commentify (match-beginning 0) (1- here-doc-end) nil)
+ (put-text-property (1- here-doc-start) here-doc-start
+ 'syntax-type 'here-doc-start)
(when (> (match-beginning 0) here-doc-start)
;; here-document has non-zero length
(cperl-modify-syntax-type (1- here-doc-start) (string-to-syntax "< c"))
@@ -3698,6 +3730,7 @@ recursive calls in starting lines of here-documents."
cperl-syntax-state nil
cperl-syntax-done-to min))
(or max (setq max (point-max)))
+ (font-lock-flush min max)
(let* (go tmpend
face head-face b e bb tag qtag b1 e1 argument i c tail tb
is-REx is-x-REx REx-subgr-start REx-subgr-end was-subgr i2 hairy-RE
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index c03eb52..5f3ba4d 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -245,6 +245,9 @@ issued by CPerl mode."
(defconst cperl--tests-heredoc-face
(if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
'font-lock-string-face))
+(defconst cperl--tests-heredoc-delim-face
+ (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
+ 'font-lock-constant-face))
(ert-deftest cperl-test-heredocs ()
"Test that HERE-docs are fontified with the appropriate face."
@@ -430,10 +433,10 @@ under timeout control."
"Verify that inserting text into a HERE-doc string with Elisp
does not break fontification."
(with-temp-buffer
- (insert "my $string = <<HERE;\n")
- (insert "One line of text.\n")
- (insert "Last line of this string.\n")
- (insert "HERE\n")
+ (insert "my $string = <<HERE;\n"
+ "One line of text.\n"
+ "Last line of this string.\n"
+ "HERE\n")
(funcall cperl-test-mode)
(font-lock-ensure)
(goto-char (point-min))
@@ -446,8 +449,51 @@ does not break fontification."
(forward-line -1)
(should (equal (get-text-property (point) 'face)
cperl--tests-heredoc-face))
- ))
-
+ (search-forward "HERE")
+ (beginning-of-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face)))
+ ;; insert into an empty here-document
+ (with-temp-buffer
+ (insert "print <<HERE;\n"
+ "HERE\n")
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (forward-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ ;; Insert a newline into the empty here-document
+ (goto-char (point-min))
+ (forward-line)
+ (insert "\n")
+ (search-forward "HERE")
+ (beginning-of-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ ;; Insert text at the beginning of the here-doc
+ (goto-char (point-min))
+ (forward-line)
+ (insert "text")
+ (font-lock-ensure)
+ (search-backward "text")
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-face))
+ (search-forward "HERE")
+ (beginning-of-line)
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ ;; Insert a new line immediately before the delimiter
+ ;; (That's where the point is anyway)
+ (insert "A new line\n")
+ (font-lock-ensure)
+ ;; The delimiter is still the delimiter
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-delim-face))
+ (forward-line -1)
+ ;; The new line has been "added" to the here-document
+ (should (equal (get-text-property (point) 'face)
+ cperl--tests-heredoc-face))))
(ert-deftest cperl-test-bug-16368 ()
"Verify that `cperl-forward-group-in-re' doesn't hide errors."
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master a1887cc: ; cperl-mode.el: Fix border cases of inserting with elisp,
Harald Jörg <=