3 (declare-function etest-resultp
"etest")
5 ;; calm down byte-compiler, you can have this one...
7 (defvar current-results
)
10 ;; The grouping of the status is for convenience and use by the
11 ;; font-locking so if you change the re don't forget to capture the
13 (defvar etest-rm-not-ok-re
"^ *\\(not ok\\) \\.\\."
14 "Regexp that will match bad test status.")
16 (defvar etest-rm-ok-re
"^ *\\(ok\\) \\.\\."
17 "Regexp that will match good test status.")
19 (defvar etest-status-re
20 (concat "\\(" etest-rm-not-ok-re
23 "Regexp that will match a test status.")
26 (let ((m (make-keymap)))
27 (define-key m
(kbd "q") 'bury-buffer
)
28 (define-key m
(kbd "g")
31 (etest-rm-refresh-buffer current-results
)))
32 (define-key m
(kbd "#") 'etest-rm-cycle-comments
)
33 (define-key m
(kbd "<tab>") 'etest-rm-toggle-headline
)
36 (defvar etest-rm-comment-visibility-types
37 '(show-all show-not-ok show-ok show-none
))
39 (defvar etest-rm-comment-visibility-map
40 '((show-all etest-rm-show-all-comments
)
41 (show-not-ok etest-rm-hide-ok-comments
)
42 (show-ok etest-rm-hide-not-ok-comments
)
43 (show-none etest-rm-hide-all-comments
))
44 "Defines how the result buffer should look when the user is
45 toggling visibility states.")
47 (defun etest-rm-count-string-at-bol (string)
48 "Count how many instances of STRING are at the start of the
51 (goto-char (point-at-bol))
52 (narrow-to-region (point) (point-at-eol))
54 (while (looking-at string
)
56 (setq count
(1+ count
)))
60 (defun etest-rm-outline-level ()
61 "Calculate what the current outline level should be. See
62 `ouline-level' for explination."
63 ;; we add one becuase there is an extra space before a status
64 (1+ (if (looking-at etest-status-re
)
65 (etest-rm-count-string-at-bol " ")
66 (etest-rm-count-string-at-bol "*"))))
69 (defun etest-result-mode (&optional results
)
70 "Mode used to display test results."
72 (kill-all-local-variables)
73 (setq buffer-read-only t
)
75 (set (make-local-variable 'outline-regexp
)
76 (concat "\\(\\*\\|" etest-status-re
"\\)"))
77 (set (make-local-variable 'outline-level
)
78 'etest-rm-outline-level
)
79 (set (make-local-variable 'current-results
) results
)
80 (setq major-mode
'etest-result-mode
)
81 (setq mode-name
"etest-result")
82 (set (make-local-variable 'font-lock-defaults
)
83 '(etest-rm-font-lock-keywords t t
))
84 (use-local-map etest-rm-map
)
85 (funcall (cadr (assoc (car etest-rm-comment-visibility-types
)
86 etest-rm-comment-visibility-map
))))
88 (defun etest-rm-pretty-print-status (result level
)
89 "The pretty printing of a single test result. "
90 (let ((returned (plist-get result
:result
)))
91 (let* ((doc (plist-get result
:doc
))
92 (comments (plist-get result
:comments
))
93 (prefix (if returned
"ok" "not ok")))
94 (insert (concat " " prefix
" "))
95 (insert-char ?\.
(- 18 (length prefix
) level
))
97 (let ((col (current-column)))
98 (insert (concat doc
"\n"))
103 (insert (concat "# " comment
"\n")))
104 (split-string comments
"\n" t
)))))))
106 (defun etest-rm-pretty-print-results (results &optional level
)
107 "Pretty print the results of a run to a buffer. See also
108 `etest-rm-pretty-print-status'."
109 (let ((level (or level
0))
113 (insert-char ?\
* (1+ level
))
114 (insert (concat " " res
"\n"))
115 (setq level
(1+ level
)))
118 (etest-rm-pretty-print-status res level
))
120 (etest-rm-pretty-print-results res level
)))
122 (etest-rm-pretty-print-results (cdr results
) level
))))
124 (defun etest-rm-refresh-buffer (results)
125 "Refresh the results buffer using the cached test results."
126 (save-selected-window
127 (switch-to-buffer-other-window (get-buffer-create "*etest*"))
128 (setq buffer-read-only nil
)
130 (etest-rm-pretty-print-results results
0)
131 (etest-result-mode results
)
132 (goto-char (point-min))
133 (when (search-forward-regexp etest-rm-not-ok-re nil t
)
134 (goto-char (point-at-bol)))))
136 (defconst etest-rm-font-lock-keywords
137 `((,etest-rm-ok-re
1 font-lock-keyword-face
)
138 (,etest-rm-not-ok-re
1 font-lock-warning-face
)
139 ("^ *\\(#.+\\)" 1 font-lock-comment-face
)
140 ("^ *\\*+ \\(.+\\)" 1 font-lock-variable-name-face
)))
142 (defun etest-rm-toggle-headline ()
143 "Toggle the visibility of a test category."
145 (unless (looking-at outline-regexp
)
146 (outline-previous-heading))
147 (if (get-char-property (point-at-eol) 'invisible
)
151 ;;; comment toggling etc...
153 (defun etest-rm-cycle-comments ()
154 "Shift the values in `etest-rm-comment-visibility-types' and
155 use the `car' of that list to determine the visibility of
158 (setq etest-rm-comment-visibility-types
160 (cdr etest-rm-comment-visibility-types
)
161 (list (car etest-rm-comment-visibility-types
))))
162 (etest-rm-refresh-buffer current-results
)
163 (message (format "%S" (car etest-rm-comment-visibility-types
))))
165 (defmacro etest-with-comments
(&rest body
)
166 "Eval BODY on each comment in the results buffer."
168 (goto-char (point-min))
169 (while (search-forward-regexp etest-status-re nil t
)
170 (outline-previous-heading)
174 (defun etest-rm-hide-not-ok-comments ()
175 "Hide all comments associated with a passing test in a result
179 (if (looking-at etest-rm-not-ok-re
)
183 (defun etest-rm-hide-ok-comments ()
184 "Hide all comments associated with a passing test in a result
188 (if (looking-at etest-rm-ok-re
)
192 (defun etest-rm-hide-all-comments ()
193 "Hide all comments in a result buffer."
198 (defun etest-rm-show-all-comments ()
199 "Show all comments in a result buffer."
204 (provide 'etest-result-mode
)