1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
;; -*- flycheck-disabled-checkers: (emacs-lisp-checkdoc) -*-
(require 'lua-mode)
(require 'buttercup)
(defun to-be-fontified-as (text faces)
(let ((expected-faces (lua-mk-font-lock-faces (funcall faces)))
(result-faces (lua-get-line-faces (funcall text)))
(lineno 1))
(when (/= (length expected-faces) (length result-faces))
(buttercup-fail "\
Fontification check failed for:
%S
Text contains %d lines, face list contains %d lines"
(funcall text) (length result-faces) (length expected-faces)))
(while expected-faces
(unless (equal (car expected-faces) (car result-faces))
(buttercup-fail "\
Fontification check failed on line %d for:
%S
Result faces: %S
Expected faces: %S"
lineno (funcall text) (car expected-faces) (car result-faces)))
(setq expected-faces (cdr expected-faces)
result-faces (cdr result-faces)
lineno (1+ lineno)))
(cons t "Fontification check passed")))
(buttercup-define-matcher :to-be-fontified-as (text faces)
(to-be-fontified-as text faces))
(defun get-str-faces (str)
"Find contiguous spans of non-default faces in STR.
E.g. for properly fontified Lua string \"local x = 100\" it should return
'(\"local\" font-lock-keyword-face
\"x\" font-lock-variable-name-face
\"100\" font-lock-constant-face)
"
(let ((pos 0)
nextpos
result prop newprop)
(while pos
(setq nextpos (next-property-change pos str)
newprop (or (get-text-property pos 'face str)
(get-text-property pos 'font-lock-face str)))
(when (not (equal prop newprop))
(setq prop newprop)
(when (listp prop)
(when (eq (car-safe (last prop)) 'default)
(setq prop (butlast prop)))
(when (= 1 (length prop))
(setq prop (car prop)))
(when (symbolp prop)
(when (eq prop 'default)
(setq prop nil))))
(when prop
(push (substring-no-properties str pos nextpos) result)
(push prop result)))
(setq pos nextpos))
(nreverse result)))
(defun lua-fontify-str (str)
"Return string fontified according to lua-mode's rules"
(with-temp-buffer
(lua-mode)
(insert str)
(font-lock-fontify-buffer)
(buffer-string)))
(defun get-buffer-line-faces ()
(font-lock-fontify-buffer)
(mapcar 'get-str-faces
(split-string (buffer-string) "\n" nil)))
(defun lua-get-line-faces (str)
"Find contiguous spans of non-default faces in each line of STR.
The result is a list of lists."
(mapcar
'get-str-faces
(split-string (lua-fontify-str str) "\n" nil)))
(defun lua-mk-font-lock-faces (sym)
"Decorate symbols with font-lock-%s-face recursively.
This is a mere typing/reading aid for lua-mode's font-lock tests."
(or (cond
((symbolp sym) (intern-soft (format "font-lock-%s-face" (symbol-name sym))))
((listp sym) (mapcar 'lua-mk-font-lock-faces sym)))
sym))
(defmacro should-lua-font-lock-equal (strs faces)
`(should (equal (lua-get-line-faces ,strs)
(lua-mk-font-lock-faces ,faces))))
;; suppress fontification messages in emacs23 output
(setq font-lock-verbose nil)
(defun lua-join-lines (strs)
(mapconcat (lambda (x) (concat x "\n")) strs ""))
(defmacro with-lua-buffer (&rest body)
(declare (debug (&rest form)))
`(with-temp-buffer
(lua-mode)
(set (make-local-variable 'lua-process) nil)
(set (make-local-variable 'lua-process-buffer) nil)
(font-lock-fontify-buffer)
(pop-to-buffer (current-buffer))
(unwind-protect
(progn ,@body)
(when (buffer-live-p lua-process-buffer)
(lua-kill-process)))))
(defun lua-get-indented-strs (strs)
(butlast
(split-string
(with-lua-buffer
(insert (replace-regexp-in-string "^\\s *" "" (lua-join-lines strs)))
(font-lock-fontify-buffer)
(indent-region (point-min) (point-max))
(buffer-substring-no-properties
(point-min) (point-max)))
"\n" nil)))
(defun lua-insert-goto-<> (strs)
"Insert sequence of strings and put point in place of \"<>\"."
(insert (lua-join-lines strs))
(goto-char (point-min))
(re-search-forward "<>")
(replace-match "")
;; Inserted text may contain multiline constructs which will only be
;; recognized after fontification.
(font-lock-fontify-buffer))
(defmacro lua-buffer-strs (&rest body)
`(butlast
(split-string
(with-lua-buffer
(progn ,@body)
(buffer-substring-no-properties (point-min) (point-max)))
"\n" nil)))
(defun lua--reindent-like (str)
(let ((strs (split-string str "\n"))
(indent-tabs-mode nil)
(font-lock-verbose nil))
(equal strs (lua-get-indented-strs strs))))
|
