diff --git a/puppet-mode.el b/puppet-mode.el index 3f516fc..3df99fc 100644 --- a/puppet-mode.el +++ b/puppet-mode.el @@ -236,6 +236,13 @@ Return nil, if there is no special context at POS, or one of (defconst puppet-rx-constituents `((symbol puppet-rx-symbol 0 nil) + ;; http://docs.puppetlabs.com/puppet/3/reference/lang_datatypes.html#regular-expressions + (regexp-literal . ,(rx (zero-or-more + (or + ;; Not the end of a regexp + (not (any "/" "\\" "\n")) + ;; Any escaped character + (and "\\" not-newline))))) ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_reserved.html#reserved-words (keyword . ,(rx (or "and" "case" "class" "default" "define" "else" "elsif" "false" "if" "in" "import" "inherits" "node" "or" @@ -328,6 +335,9 @@ are available: `(symbol SEXP …)' Match SEXPs inside symbol boundaries only +`regexp-literal' + A Puppet regexp literal, *without* surrounding slashes + `keyword' Any valid Puppet keyword @@ -661,12 +671,6 @@ of the initial include plus puppet-include-indent." (defvar puppet-font-lock-keywords `( - ;; Regular expression literals - (,(rx (group "/" - (zero-or-more - (or (not (any "/" "\\" "\n")) ; Not the end of a regexp - (and "\\" not-newline))) ; Any escaped character - "/")) 1 'puppet-regular-expression-literal) ;; Keywords (,(puppet-rx (symbol keyword)) 0 font-lock-keyword-face) ;; Variables @@ -718,16 +722,19 @@ of the initial include plus puppet-include-indent." (puppet-match-invalid-expansion 1 font-lock-warning-face t) ;; Escape sequences in strings (puppet-match-valid-escape 1 'puppet-escape-sequence t) - ) + ;; Regexp literals + (puppet-match-regexp-literal (1 'puppet-regular-expression-literal t) + (2 'puppet-regular-expression-literal t) + (3 'puppet-regular-expression-literal t))) "Font lock keywords for Puppet Mode.") (defun puppet-match-property (property context limit) "Match a PROPERTY in CONTEXT before LIMIT. PROPERTY is the text property to look for. CONTEXT is one of -`single-quoted', `double-quoted' or `comment', or a list with any -of these symbols. The expansion will only match if it is in any -given CONTEXT." +`single-quoted', `double-quoted', `comment' or nil, or a list +with any of these symbols. The expansion will only match if it +is in any given CONTEXT. nil means no specific syntactic context." (when (symbolp context) (setq context (list context))) (let* ((pos (next-single-char-property-change (point) property nil limit))) @@ -759,21 +766,26 @@ string." "Match a valid escape sequence before LIMIT." (puppet-match-property 'puppet-escape 'double-quoted limit)) -(defun puppet-syntax-propertize-match (property) - "Propertize a match with PROPERTY. +(defun puppet-match-regexp-literal (limit) + "Match a regular expression literal before LIMIT." + (puppet-match-property 'puppet-regexp-literal nil limit)) + +(defun puppet-syntax-propertize-match (property &optional group) + "Propertize a match with PROPERTY at GROUP's beginning. When in a special syntax context, add PROPERTY to the first -character of the first group of the current `match-data'. The -value of PROPERTY is `(CONTEXT . MATCH-DATA)', where CONTEXT is -one of nil, `single-quoted', `double-quoted' or `comment' and +character of the given GROUP of the current `match-data'. GROUP +defaults to the first group. + +The value of PROPERTY is `(CONTEXT . MATCH-DATA)', where CONTEXT +is one of nil, `single-quoted', `double-quoted' or `comment' and denotes the surrounding context, and MATCH-DATA is the original match data from propertization." - (let* ((beg (match-beginning 1)) + (let* ((beg (match-beginning (or group 1))) ;; Syntax functions can modify the match data, so we must preserve it (context (save-match-data (puppet-syntax-context)))) - (when context - (put-text-property beg (1+ beg) property - (cons context (match-data)))))) + (put-text-property beg (1+ beg) property + (cons context (match-data))))) (defun puppet-syntax-propertize-scope-operator (beg end) "Mark all scope operators between BEG and END as symbols." @@ -790,7 +802,9 @@ match data from propertization." Used as `syntax-propertize-function' in Puppet Mode." (let ((case-fold-search nil)) (goto-char start) - (remove-text-properties start end '(puppet-expansion puppet-escape)) + (remove-text-properties start end '(puppet-expansion + puppet-escape + puppet-regexp-literal)) (funcall (syntax-propertize-rules ;; Make double colons part of the surrounding symbol. We can't put the @@ -799,6 +813,31 @@ Used as `syntax-propertize-function' in Puppet Mode." ;; double-colon as part of the symbol to make symbol navigation move ;; across it, and to make stuff like `thing-at-point' behave reasonably ((rx "::" symbol-start) (0 "_")) + ;; Mark regular expression literals in proper contexts (nodes, cases, + ;; selectors and match operators) as strings, to make them play nicely + ;; with sexp navigation and SMIE. Also propertize them for use in font + ;; lock keywords, since we want to apply our own + ;; puppet-regular-expression-literal face instead of the generic string + ;; face. + ((puppet-rx (group "/") + (group regexp-literal) + (group "/") + (zero-or-more space) + (or ":" "=>")) + ;; We propertize the body of the regexp literal, not its delimiters, to + ;; make sure that font lock keywords kick in when the literal gets moved + ;; with point on separator. The separator is propertized by syntactic + ;; font lock (since we marked it as string delimiter), so font lock + ;; keywords will start in the body of the literal. If we'd propertize + ;; the separator, font lock keywords would miss the property + (0 (ignore (puppet-syntax-propertize-match 'puppet-regexp-literal 2))) + (1 "|") (3 "|")) + ((puppet-rx (or "=~" "!~" (symbol "node")) (zero-or-more space) + (group "/") + (group regexp-literal) + (group "/")) + (0 (ignore (puppet-syntax-propertize-match 'puppet-regexp-literal 2))) + (1 "|") (3 "|")) ;; Find escape sequences and variable expansions. ((puppet-rx dq-escape) (1 (ignore (puppet-syntax-propertize-match 'puppet-escape)))) diff --git a/test/puppet-mode-test.el b/test/puppet-mode-test.el index c5d7537..74fac85 100644 --- a/test/puppet-mode-test.el +++ b/test/puppet-mode-test.el @@ -41,8 +41,9 @@ (indent 1)) `(with-temp-buffer (insert ,content) - (goto-char (point-min)) (puppet-mode) + (font-lock-fontify-buffer) + (goto-char (point-min)) ,@body)) (defun puppet-test-face-at (pos &optional content) @@ -52,11 +53,36 @@ If CONTENT is not given, return the face at POS in the current buffer." (if content (puppet-test-with-temp-buffer content - (font-lock-fontify-buffer) (get-text-property pos 'face)) - (font-lock-fontify-buffer) (get-text-property pos 'face))) +(defconst puppet-test-syntax-classes + [whitespace punctuation word symbol open-paren close-paren expression-prefix + string-quote paired-delim escape character-quote comment-start + comment-end inherit generic-comment generic-string] + "Readable symbols for syntax classes. + +Each symbol in this vector corresponding to the syntax code of +its index.") + +(defun puppet-test-syntax-at (pos) + "Get the syntax at POS. + +Get the syntax class symbol at POS, or nil if there is no syntax a +POS." + (let ((code (syntax-class (syntax-after pos)))) + (aref puppet-test-syntax-classes code))) + + +;;;; Navigation + +(ert-deftest puppet-syntax-propertize-function/forward-sexp-moves-across-regexp-literals () + :tags '(navigation syntax-properties) + (puppet-test-with-temp-buffer "$foo =~ / (class|node) $foo/ {" + (search-forward "=~") ; Point is before opening / now + (forward-sexp) + (should (looking-at " {")))) + ;;;; Font locking @@ -88,20 +114,95 @@ class */ bar" (should (eq (puppet-test-face-at 11) 'font-lock-comment-face)) (should-not (puppet-test-face-at 13)))) -(ert-deftest puppet-font-lock-keywords/regular-expression-literal () +(ert-deftest puppet-syntax-propertize-function/regular-expression-literal-match-op () + :tags '(syntax-table syntax-properties) + (puppet-test-with-temp-buffer "$foo =~ / class $foo/ {" + (should (eq (puppet-test-syntax-at 9) 'generic-string)) + (should (eq (puppet-test-syntax-at 21) 'generic-string)))) + +(ert-deftest puppet-syntax-propertize-function/regular-expression-literal-no-match-op () + :tags '(syntax-table syntax-properties) + (puppet-test-with-temp-buffer "$foo !~ / class $foo/ {" + (should (eq (puppet-test-syntax-at 9) 'generic-string)) + (should (eq (puppet-test-syntax-at 21) 'generic-string)))) + +(ert-deftest puppet-syntax-propertize-function/regular-expression-literal-node () + :tags '(syntax-table syntax-properties) + (puppet-test-with-temp-buffer "node / class $foo/ {" + (should (eq (puppet-test-syntax-at 6) 'generic-string)) + (should (eq (puppet-test-syntax-at 6) 'generic-string)))) + +(ert-deftest puppet-syntax-propertize-function/regular-expression-literal-selector () + :tags '(syntax-table syntax-properties) + (puppet-test-with-temp-buffer "/ class $foo/=>" + (should (eq (puppet-test-syntax-at 1) 'generic-string)) + (should (eq (puppet-test-syntax-at 13) 'generic-string)))) + +(ert-deftest puppet-syntax-propertize-function/regular-expression-case () + :tags '(syntax-table syntax-properties) + (puppet-test-with-temp-buffer "/ class $foo/:" + (should (eq (puppet-test-syntax-at 1) 'generic-string)) + (should (eq (puppet-test-syntax-at 13) 'generic-string)))) + +(ert-deftest puppet-syntax-propertize-function/invalid-regular-expression () + :tags '(syntax-table syntax-properties) + (puppet-test-with-temp-buffer "$foo = / class $foo/" + (should (eq (puppet-test-syntax-at 8) 'punctuation)) + (should (eq (puppet-test-syntax-at 20) 'punctuation)))) + +(ert-deftest puppet-font-lock-keywords/regular-expression-literal-match-op () :tags '(fontification font-lock-keywords) (puppet-test-with-temp-buffer "$foo =~ / class $foo/ {" - ;; The opening slash (should (eq (puppet-test-face-at 9) 'puppet-regular-expression-literal)) - ;; A keyword inside a regexp literal (should (eq (puppet-test-face-at 11) 'puppet-regular-expression-literal)) - ;; A variable inside a regexp literal (should (eq (puppet-test-face-at 17) 'puppet-regular-expression-literal)) - ;; The closing delimiter (should (eq (puppet-test-face-at 21) 'puppet-regular-expression-literal)) - ;; The subsequent brace (should-not (puppet-test-face-at 23)))) +(ert-deftest puppet-font-lock-keywords/regular-expression-literal-no-match-op () + :tags '(fontification font-lock-keywords) + (puppet-test-with-temp-buffer "$foo !~ / class $foo/ {" + (should (eq (puppet-test-face-at 9) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 11) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 17) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 21) 'puppet-regular-expression-literal)) + (should-not (puppet-test-face-at 23)))) + +(ert-deftest puppet-font-lock-keywords/regular-expression-literal-node () + :tags '(fontification font-lock-keywords) + (puppet-test-with-temp-buffer "node / class $foo/ {" + (should (eq (puppet-test-face-at 6) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 8) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 14) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 18) 'puppet-regular-expression-literal)) + (should-not (puppet-test-face-at 20)))) + +(ert-deftest puppet-font-lock-keywords/regular-expression-literal-selector () + :tags '(fontification font-lock-keywords) + (puppet-test-with-temp-buffer "/ class $foo/=>" + (should (eq (puppet-test-face-at 1) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 3) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 9) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 13) 'puppet-regular-expression-literal)) + (should-not (puppet-test-face-at 14)))) + +(ert-deftest puppet-font-lock-keywords/regular-expression-case () + :tags '(fontification font-lock-keywords) + (puppet-test-with-temp-buffer "/ class $foo/:" + (should (eq (puppet-test-face-at 1) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 3) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 9) 'puppet-regular-expression-literal)) + (should (eq (puppet-test-face-at 13) 'puppet-regular-expression-literal)) + (should-not (puppet-test-face-at 14)))) + +(ert-deftest puppet-font-lock-keywords/invalid-regular-expression () + :tags '(fontification font-lock-keywords) + (puppet-test-with-temp-buffer "$foo = / class $foo/" + (should-not (puppet-test-face-at 8)) + (should (eq (puppet-test-face-at 10) 'font-lock-keyword-face)) + (should (eq (puppet-test-face-at 16) 'font-lock-variable-name-face)) + (should-not (puppet-test-face-at 20)))) + (ert-deftest puppet-font-lock-keywords/keyword-in-symbol () :tags '(fontification font-lock-keywords) (should-not (puppet-test-face-at 4 "fooclass")))