[nongnu] elpa/raku-mode 0d3485a324 027/253: Better highlighting angled quotes, and set operators

[ELPA Syncer]

branch: elpa/raku-mode
commit 0d3485a3245e3aacc82a44c8533847311cf327b3
Author: Hinrik Örn Sigurðsson <hinrik.sig@gmail.com>
Commit: Hinrik Örn Sigurðsson <hinrik.sig@gmail.com>

    Better highlighting angled quotes, and set operators
---
 perl6-font-lock.el      | 69 ++++++++++++++++++++++++++-----------------------
 test/perl6-mode-test.el |  4 +++
 2 files changed, 40 insertions(+), 33 deletions(-)

diff --git a/perl6-font-lock.el b/perl6-font-lock.el
index a2452c0f5b..7bdd193fa7 100644
--- a/perl6-font-lock.el
+++ b/perl6-font-lock.el
@@ -227,26 +227,33 @@ LENGTH is the length of the brackets (e.g. 2 for a 
<<foo>>)."
             (put-text-property (- comment-end 1) comment-end
                                'syntax-table (string-to-syntax "!"))))))))
 
-(defun perl6-syntax-propertize-angle ()
-  "Add syntax properties to angle-bracketed quotes (<foo bar>)."
-  (unless (or (looking-at "[-=]")
-              (looking-back "[+~=!]<" 2))
-    (when (or (or (not (looking-at "[\s\n]"))
-                  (not (looking-back "[\s\n]<" 1)))
-              (looking-at "<\s+>")
-              (looking-back "=\s+<")
-              (looking-back "\(\s*<")
-              (or (looking-at "\s*$") (looking-back "^\s*<"))
-              (looking-back (perl6-rx (symbol (or "enum" "for" "any" "all" 
"none"))
-                                (0+ space) (opt "\)") (0+ space) "<")))
-      (let ((quote-beg (- (point) 1)))
-        (put-text-property quote-beg (1+ quote-beg)
-                           'syntax-table (string-to-syntax "|"))
-        (search-forward ">")
-        (let ((quote-end (- (point) 1)))
-          (put-text-property quote-beg quote-end 'syntax-multiline t)
-          (put-text-property quote-end (1+ quote-end)
-                             'syntax-table (string-to-syntax "|")))))))
+(defun perl6-syntax-propertize-angles (open-angles)
+  "Add syntax properties to angle-bracketed quotes (e.g. <foo > and «bar»).
+
+OPEN-ANGLES is the opening delimiter (e.g. \"«\" or \"<<\")."
+  (with-syntax-table perl6-bracket-syntax-table
+    (let* ((angle-length (length open-angles))
+           (open-angle (string-to-char (car (split-string open-angles "" t))))
+           (close-angle (matching-paren open-angle))
+           (quote-beg (- (point) angle-length)))
+      (unless (or (looking-at "[-=]")
+                  (looking-back (rx-to-string `(and (char "+~=!") 
,open-angle)) 2))
+        (when (or (or (not (looking-at "[\s\n]"))
+                      (not (looking-back (rx-to-string `(and (char "\s\n") 
,open-angle)) 2)))
+                  (looking-at (rx-to-string `(and ,open-angle (1+ (char 
"\s\n")) ,close-angle)))
+                  (looking-back (rx-to-string `(and "=" (1+ space) 
,open-angle)))
+                  (looking-back (rx-to-string `(and "\(" (0+ space) 
,open-angle)))
+                  (or (looking-at "\s*$")
+                      (looking-back (rx-to-string `(and line-start (0+ space) 
,open-angle))))
+                  (looking-back (rx-to-string `(and symbol-start (or "enum" 
"for" "any" "all" "none")
+                                          (0+ space) (opt "\)") (0+ space) 
,open-angle))))
+          (put-text-property quote-beg (1+ quote-beg)
+                             'syntax-table (string-to-syntax "|"))
+          (perl6-forward-brackets open-angle close-angle angle-length)
+          (let ((quote-end (- (point) 1)))
+            (put-text-property quote-beg quote-end 'syntax-multiline t)
+            (put-text-property quote-end (1+ quote-end)
+                               'syntax-table (string-to-syntax "|"))))))))
 
 (defun perl6-syntax-propertize (start end)
   "Add context-specific syntax properties to code.
@@ -265,16 +272,12 @@ Takes arguments START and END which delimit the region to 
propertize."
        (0 "_"))
       ((rx "#`")
        (0 (ignore (perl6-syntax-propertize-embedded-comment))))
-      ((rx (group "«") (0+ (not-char "»")) (opt (group "»")))
-       (0 (ignore (put-text-property (match-beginning 0) (match-end 0) 
'syntax-multiline t)))
-       (1 "|")
-       (2 "|"))
-      ((rx (group "<") "<" (0+ (not-char ">")) (opt (and ">" (group ">"))))
-       (0 (ignore (put-text-property (match-beginning 0) (match-end 0) 
'syntax-multiline t)))
-       (1 "|")
-       (2 "|"))
-      ((rx "<")
-       (0 (ignore (perl6-syntax-propertize-angle)))))
+      ;; set operators
+      ((rx (opt "R") "\(" (or (char "-^.+|&") (and (char "<>") (opt (char 
"=+"))) "cont" "elem") "\)")
+       (0 (prog1 "." (put-text-property (match-beginning 0) (match-end 0)
+                                        'font-lock-face 'perl6-operator))))
+      ((rx (1+ (char "<«")))
+       (0 (ignore (perl6-syntax-propertize-angles (match-string 0))))))
       start end)))
 
 (defun perl6-font-lock-syntactic-face (state)
@@ -295,7 +298,7 @@ Takes STATE, the parse state."
     (,(perl6-rx (group symbol-start high-type) "(") 1 'perl6-type)
     (,(perl6-rx (group symbol-start identifier) "(") 1 'perl6-identifier)
     (,(perl6-rx (symbol (or low-type high-type))) 0 'perl6-type)
-    (,(perl6-rx (or (symbol operator-word) operator-char)) 0 'perl6-operator)
+    (,(perl6-rx (symbol operator-word)) 0 'perl6-operator)
     (,(perl6-rx (symbol phaser)) 0 'perl6-phaser)
     (,(perl6-rx (symbol exception)) 0 'perl6-exception)
     (,(perl6-rx (symbol module)) 0 'perl6-module)
@@ -306,8 +309,8 @@ Takes STATE, the parse state."
     (,(perl6-rx (symbol loop)) 0 'perl6-loop)
     (,(perl6-rx (symbol flow-control)) 0 'perl6-flow-control)
     (,(perl6-rx (symbol pragma)) 0 'perl6-pragma)
-    (,(perl6-rx (symbol operator-word)) 0 'perl6-operator)
-    (,(perl6-rx (symbol identifier)) 0 'perl6-identifier))
+    (,(perl6-rx (symbol identifier)) 0 'perl6-identifier)
+    (,(perl6-rx operator-char) 0 'perl6-operator))
   "Font lock keywords for Perl 6.")
 
 (provide 'perl6-font-lock)
diff --git a/test/perl6-mode-test.el b/test/perl6-mode-test.el
index a665d3a8e1..3cb52014cd 100644
--- a/test/perl6-mode-test.el
+++ b/test/perl6-mode-test.el
@@ -81,6 +81,10 @@ POS."
   :tags '(fontification syntax-table)
   (should (eq (perl6-test-face-at 8 "$foo = \"bar\"") 'perl6-string)))
 
+(ert-deftest perl6-mode-syntax-table/fontify-set-operator ()
+  :tags '(fontification syntax-table)
+  (should (eq (perl6-test-face-at 6 "$mh (<+) $m") 'perl6-operator)))
+
 (ert-deftest perl6-mode-syntax-table/fontify-sq-string ()
   :tags '(fontification syntax-table)
   (should (eq (perl6-test-face-at 8 "$foo = 'bar'") 'perl6-string)))