Commit | Line | Data |
---|---|---|
34850cd5 AK |
1 | ;;; guix-build-log.el --- Major and minor modes for build logs -*- lexical-binding: t -*- |
2 | ||
3 | ;; Copyright © 2015 Alex Kost <alezost@gmail.com> | |
4 | ||
5 | ;; This file is part of GNU Guix. | |
6 | ||
7 | ;; GNU Guix is free software; you can redistribute it and/or modify | |
8 | ;; it under the terms of the GNU General Public License as published by | |
9 | ;; the Free Software Foundation, either version 3 of the License, or | |
10 | ;; (at your option) any later version. | |
11 | ||
12 | ;; GNU Guix is distributed in the hope that it will be useful, | |
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;; GNU General Public License for more details. | |
16 | ||
17 | ;; You should have received a copy of the GNU General Public License | |
18 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ;;; Commentary: | |
21 | ||
22 | ;; This file provides a major mode (`guix-build-log-mode') and a minor mode | |
23 | ;; (`guix-build-log-minor-mode') for highlighting Guix build logs. | |
24 | ||
25 | ;;; Code: | |
26 | ||
dcb00c0a AK |
27 | (require 'guix-utils) |
28 | ||
34850cd5 AK |
29 | (defgroup guix-build-log nil |
30 | "Settings for `guix-build-log-mode'." | |
31 | :group 'guix) | |
32 | ||
33 | (defgroup guix-build-log-faces nil | |
34 | "Faces for `guix-build-log-mode'." | |
35 | :group 'guix-build-log | |
36 | :group 'guix-faces) | |
37 | ||
38 | (defface guix-build-log-title-head | |
39 | '((t :inherit font-lock-keyword-face)) | |
40 | "Face for '@' symbol of a log title." | |
41 | :group 'guix-build-log-faces) | |
42 | ||
43 | (defface guix-build-log-title-start | |
44 | '((t :inherit guix-build-log-title-head)) | |
45 | "Face for a log title denoting a start of a process." | |
46 | :group 'guix-build-log-faces) | |
47 | ||
48 | (defface guix-build-log-title-success | |
49 | '((t :inherit guix-build-log-title-head)) | |
50 | "Face for a log title denoting a successful end of a process." | |
51 | :group 'guix-build-log-faces) | |
52 | ||
53 | (defface guix-build-log-title-fail | |
54 | '((t :inherit error)) | |
55 | "Face for a log title denoting a failed end of a process." | |
56 | :group 'guix-build-log-faces) | |
57 | ||
58 | (defface guix-build-log-title-end | |
59 | '((t :inherit guix-build-log-title-head)) | |
60 | "Face for a log title denoting an undefined end of a process." | |
61 | :group 'guix-build-log-faces) | |
62 | ||
63 | (defface guix-build-log-phase-name | |
64 | '((t :inherit font-lock-function-name-face)) | |
65 | "Face for a phase name." | |
66 | :group 'guix-build-log-faces) | |
67 | ||
68 | (defface guix-build-log-phase-start | |
69 | '((default :weight bold) | |
70 | (((class grayscale) (background light)) :foreground "Gray90") | |
71 | (((class grayscale) (background dark)) :foreground "DimGray") | |
72 | (((class color) (min-colors 16) (background light)) | |
73 | :foreground "DarkGreen") | |
74 | (((class color) (min-colors 16) (background dark)) | |
75 | :foreground "LimeGreen") | |
76 | (((class color) (min-colors 8)) :foreground "green")) | |
77 | "Face for the start line of a phase." | |
78 | :group 'guix-build-log-faces) | |
79 | ||
80 | (defface guix-build-log-phase-end | |
81 | '((((class grayscale) (background light)) :foreground "Gray90") | |
82 | (((class grayscale) (background dark)) :foreground "DimGray") | |
83 | (((class color) (min-colors 16) (background light)) | |
84 | :foreground "ForestGreen") | |
85 | (((class color) (min-colors 16) (background dark)) | |
86 | :foreground "LightGreen") | |
87 | (((class color) (min-colors 8)) :foreground "green") | |
88 | (t :weight bold)) | |
89 | "Face for the end line of a phase." | |
90 | :group 'guix-build-log-faces) | |
91 | ||
92 | (defface guix-build-log-phase-success | |
93 | '((t)) | |
94 | "Face for the 'succeeded' word of a phase line." | |
95 | :group 'guix-build-log-faces) | |
96 | ||
97 | (defface guix-build-log-phase-fail | |
98 | '((t :inherit error)) | |
99 | "Face for the 'failed' word of a phase line." | |
100 | :group 'guix-build-log-faces) | |
101 | ||
102 | (defface guix-build-log-phase-seconds | |
103 | '((t :inherit font-lock-constant-face)) | |
104 | "Face for the number of seconds for a phase." | |
105 | :group 'guix-build-log-faces) | |
106 | ||
f4044b58 AK |
107 | (defcustom guix-build-log-minor-mode-activate t |
108 | "If non-nil, then `guix-build-log-minor-mode' is automatically | |
109 | activated in `shell-mode' buffers." | |
110 | :type 'boolean | |
111 | :group 'guix-build-log) | |
112 | ||
c42e6c6c | 113 | (defcustom guix-build-log-mode-hook '() |
34850cd5 AK |
114 | "Hook run after `guix-build-log-mode' is entered." |
115 | :type 'hook | |
116 | :group 'guix-build-log) | |
117 | ||
118 | (defvar guix-build-log-phase-name-regexp "`\\([^']+\\)'" | |
119 | "Regexp for a phase name.") | |
120 | ||
121 | (defvar guix-build-log-phase-start-regexp | |
122 | (concat "^starting phase " guix-build-log-phase-name-regexp) | |
123 | "Regexp for the start line of a 'build' phase.") | |
124 | ||
125 | (defun guix-build-log-title-regexp (&optional state) | |
126 | "Return regexp for the log title. | |
127 | STATE is a symbol denoting a state of the title. It should be | |
128 | `start', `fail', `success' or `nil' (for a regexp matching any | |
129 | state)." | |
130 | (let* ((word-rx (rx (1+ (any word "-")))) | |
131 | (state-rx (cond ((eq state 'start) (concat word-rx "started")) | |
132 | ((eq state 'success) (concat word-rx "succeeded")) | |
133 | ((eq state 'fail) (concat word-rx "failed")) | |
134 | (t word-rx)))) | |
135 | (rx-to-string | |
136 | `(and bol (group "@") " " (group (regexp ,state-rx))) | |
137 | t))) | |
138 | ||
139 | (defun guix-build-log-phase-end-regexp (&optional state) | |
140 | "Return regexp for the end line of a 'build' phase. | |
141 | STATE is a symbol denoting how a build phase was ended. It should be | |
142 | `fail', `success' or `nil' (for a regexp matching any state)." | |
143 | (let ((state-rx (cond ((eq state 'success) "succeeded") | |
144 | ((eq state 'fail) "failed") | |
145 | (t (regexp-opt '("succeeded" "failed")))))) | |
146 | (rx-to-string | |
147 | `(and bol "phase " (regexp ,guix-build-log-phase-name-regexp) | |
148 | " " (group (regexp ,state-rx)) " after " | |
665ce1eb | 149 | (group (1+ (or digit "."))) " seconds") |
34850cd5 AK |
150 | t))) |
151 | ||
eda1cc8b AK |
152 | (defvar guix-build-log-phase-end-regexp |
153 | ;; For efficiency, it is better to have a regexp for the general line | |
154 | ;; of the phase end, then to call the function all the time. | |
155 | (guix-build-log-phase-end-regexp) | |
156 | "Regexp for the end line of a 'build' phase.") | |
157 | ||
34850cd5 AK |
158 | (defvar guix-build-log-font-lock-keywords |
159 | `((,(guix-build-log-title-regexp 'start) | |
160 | (1 'guix-build-log-title-head) | |
161 | (2 'guix-build-log-title-start)) | |
162 | (,(guix-build-log-title-regexp 'success) | |
163 | (1 'guix-build-log-title-head) | |
164 | (2 'guix-build-log-title-success)) | |
165 | (,(guix-build-log-title-regexp 'fail) | |
166 | (1 'guix-build-log-title-head) | |
167 | (2 'guix-build-log-title-fail)) | |
168 | (,(guix-build-log-title-regexp) | |
169 | (1 'guix-build-log-title-head) | |
170 | (2 'guix-build-log-title-end)) | |
171 | (,guix-build-log-phase-start-regexp | |
172 | (0 'guix-build-log-phase-start) | |
173 | (1 'guix-build-log-phase-name prepend)) | |
174 | (,(guix-build-log-phase-end-regexp 'success) | |
175 | (0 'guix-build-log-phase-end) | |
176 | (1 'guix-build-log-phase-name prepend) | |
177 | (2 'guix-build-log-phase-success prepend) | |
178 | (3 'guix-build-log-phase-seconds prepend)) | |
179 | (,(guix-build-log-phase-end-regexp 'fail) | |
180 | (0 'guix-build-log-phase-end) | |
181 | (1 'guix-build-log-phase-name prepend) | |
182 | (2 'guix-build-log-phase-fail prepend) | |
183 | (3 'guix-build-log-phase-seconds prepend))) | |
184 | "A list of `font-lock-keywords' for `guix-build-log-mode'.") | |
185 | ||
20ce2fee | 186 | (defvar guix-build-log-common-map |
34850cd5 | 187 | (let ((map (make-sparse-keymap))) |
34850cd5 AK |
188 | (define-key map (kbd "M-n") 'guix-build-log-next-phase) |
189 | (define-key map (kbd "M-p") 'guix-build-log-previous-phase) | |
eda1cc8b AK |
190 | (define-key map (kbd "TAB") 'guix-build-log-phase-toggle) |
191 | (define-key map (kbd "<tab>") 'guix-build-log-phase-toggle) | |
192 | (define-key map (kbd "<backtab>") 'guix-build-log-phase-toggle-all) | |
193 | (define-key map [(shift tab)] 'guix-build-log-phase-toggle-all) | |
34850cd5 | 194 | map) |
20ce2fee AK |
195 | "Parent keymap for 'build-log' buffers. |
196 | For `guix-build-log-mode' this map is used as is. | |
197 | For `guix-build-log-minor-mode' this map is prefixed with 'C-c'.") | |
198 | ||
199 | (defvar guix-build-log-mode-map | |
200 | (let ((map (make-sparse-keymap))) | |
201 | (set-keymap-parent | |
202 | map (make-composed-keymap (list guix-build-log-common-map) | |
203 | special-mode-map)) | |
c42e6c6c AK |
204 | (define-key map (kbd "c") 'compilation-shell-minor-mode) |
205 | (define-key map (kbd "v") 'view-mode) | |
20ce2fee | 206 | map) |
34850cd5 AK |
207 | "Keymap for `guix-build-log-mode' buffers.") |
208 | ||
20ce2fee AK |
209 | (defvar guix-build-log-minor-mode-map |
210 | (let ((map (make-sparse-keymap))) | |
211 | (define-key map (kbd "C-c") guix-build-log-common-map) | |
212 | map) | |
213 | "Keymap for `guix-build-log-minor-mode' buffers.") | |
214 | ||
eda1cc8b AK |
215 | (defun guix-build-log-phase-start (&optional with-header?) |
216 | "Return the start point of the current build phase. | |
217 | If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header. | |
218 | Return nil, if there is no phase start before the current point." | |
219 | (save-excursion | |
220 | (end-of-line) | |
221 | (when (re-search-backward guix-build-log-phase-start-regexp nil t) | |
222 | (unless with-header? (end-of-line)) | |
223 | (point)))) | |
224 | ||
225 | (defun guix-build-log-phase-end () | |
226 | "Return the end point of the current build phase." | |
227 | (save-excursion | |
228 | (beginning-of-line) | |
229 | (when (re-search-forward guix-build-log-phase-end-regexp nil t) | |
230 | (point)))) | |
231 | ||
232 | (defun guix-build-log-phase-hide () | |
233 | "Hide the body of the current build phase." | |
234 | (interactive) | |
235 | (let ((beg (guix-build-log-phase-start)) | |
236 | (end (guix-build-log-phase-end))) | |
237 | (when (and beg end) | |
238 | ;; If not on the header line, move to it. | |
239 | (when (and (> (point) beg) | |
240 | (< (point) end)) | |
241 | (goto-char (guix-build-log-phase-start t))) | |
242 | (remove-overlays beg end 'invisible t) | |
243 | (let ((o (make-overlay beg end))) | |
244 | (overlay-put o 'evaporate t) | |
245 | (overlay-put o 'invisible t))))) | |
246 | ||
247 | (defun guix-build-log-phase-show () | |
248 | "Show the body of the current build phase." | |
249 | (interactive) | |
250 | (let ((beg (guix-build-log-phase-start)) | |
251 | (end (guix-build-log-phase-end))) | |
252 | (when (and beg end) | |
253 | (remove-overlays beg end 'invisible t)))) | |
254 | ||
255 | (defun guix-build-log-phase-hidden-p () | |
256 | "Return non-nil, if the body of the current build phase is hidden." | |
257 | (let ((beg (guix-build-log-phase-start))) | |
258 | (and beg | |
259 | (cl-some (lambda (o) | |
260 | (overlay-get o 'invisible)) | |
261 | (overlays-at beg))))) | |
262 | ||
263 | (defun guix-build-log-phase-toggle-function () | |
264 | "Return a function to toggle the body of the current build phase." | |
265 | (if (guix-build-log-phase-hidden-p) | |
266 | #'guix-build-log-phase-show | |
267 | #'guix-build-log-phase-hide)) | |
268 | ||
269 | (defun guix-build-log-phase-toggle () | |
270 | "Show/hide the body of the current build phase." | |
271 | (interactive) | |
272 | (funcall (guix-build-log-phase-toggle-function))) | |
273 | ||
274 | (defun guix-build-log-phase-toggle-all () | |
275 | "Show/hide the bodies of all build phases." | |
276 | (interactive) | |
277 | (save-excursion | |
278 | ;; Some phases may be hidden, and some shown. Whether to hide or to | |
279 | ;; show them, it is determined by the state of the first phase here. | |
280 | (goto-char (point-min)) | |
7c786db4 AK |
281 | (let ((fun (save-excursion |
282 | (re-search-forward guix-build-log-phase-start-regexp nil t) | |
283 | (guix-build-log-phase-toggle-function)))) | |
eda1cc8b AK |
284 | (while (re-search-forward guix-build-log-phase-start-regexp nil t) |
285 | (funcall fun))))) | |
286 | ||
34850cd5 AK |
287 | (defun guix-build-log-next-phase (&optional arg) |
288 | "Move to the next build phase. | |
289 | With ARG, do it that many times. Negative ARG means move | |
290 | backward." | |
291 | (interactive "^p") | |
292 | (if arg | |
293 | (when (zerop arg) (user-error "Try again")) | |
294 | (setq arg 1)) | |
295 | (let ((search-fun (if (> arg 0) | |
296 | #'re-search-forward | |
297 | #'re-search-backward)) | |
298 | (n (abs arg)) | |
299 | found last-found) | |
300 | (save-excursion | |
301 | (end-of-line (if (> arg 0) 1 0)) ; skip the current line | |
302 | (while (and (not (zerop n)) | |
303 | (setq found | |
304 | (funcall search-fun | |
305 | guix-build-log-phase-start-regexp | |
306 | nil t))) | |
307 | (setq n (1- n) | |
308 | last-found found))) | |
309 | (when last-found | |
310 | (goto-char last-found) | |
311 | (forward-line 0)) | |
312 | (or found | |
313 | (user-error (if (> arg 0) | |
314 | "No next build phase" | |
315 | "No previous build phase"))))) | |
316 | ||
317 | (defun guix-build-log-previous-phase (&optional arg) | |
318 | "Move to the previous build phase. | |
319 | With ARG, do it that many times. Negative ARG means move | |
320 | forward." | |
321 | (interactive "^p") | |
322 | (guix-build-log-next-phase (- (or arg 1)))) | |
323 | ||
324 | ;;;###autoload | |
325 | (define-derived-mode guix-build-log-mode special-mode | |
326 | "Guix-Build-Log" | |
327 | "Major mode for viewing Guix build logs. | |
328 | ||
329 | \\{guix-build-log-mode-map}" | |
330 | (setq font-lock-defaults '(guix-build-log-font-lock-keywords t))) | |
331 | ||
332 | ;;;###autoload | |
333 | (define-minor-mode guix-build-log-minor-mode | |
334 | "Toggle Guix Build Log minor mode. | |
335 | ||
336 | With a prefix argument ARG, enable Guix Build Log minor mode if | |
337 | ARG is positive, and disable it otherwise. If called from Lisp, | |
338 | enable the mode if ARG is omitted or nil. | |
339 | ||
340 | When Guix Build Log minor mode is enabled, it highlights build | |
341 | log in the current buffer. This mode can be enabled | |
342 | programmatically using hooks: | |
343 | ||
20ce2fee AK |
344 | (add-hook 'shell-mode-hook 'guix-build-log-minor-mode) |
345 | ||
346 | \\{guix-build-log-minor-mode-map}" | |
34850cd5 AK |
347 | :init-value nil |
348 | :lighter " Guix-Build-Log" | |
20ce2fee | 349 | :keymap guix-build-log-minor-mode-map |
34850cd5 AK |
350 | :group 'guix-build-log |
351 | (if guix-build-log-minor-mode | |
352 | (font-lock-add-keywords nil guix-build-log-font-lock-keywords) | |
353 | (font-lock-remove-keywords nil guix-build-log-font-lock-keywords)) | |
354 | (when font-lock-mode | |
355 | (font-lock-fontify-buffer))) | |
356 | ||
f4044b58 AK |
357 | ;;;###autoload |
358 | (defun guix-build-log-minor-mode-activate-maybe () | |
359 | "Activate `guix-build-log-minor-mode' depending on | |
360 | `guix-build-log-minor-mode-activate' variable." | |
361 | (when guix-build-log-minor-mode-activate | |
362 | (guix-build-log-minor-mode))) | |
363 | ||
dcb00c0a AK |
364 | (defun guix-build-log-find-file (file-or-url) |
365 | "Open FILE-OR-URL in `guix-build-log-mode'." | |
366 | (guix-find-file-or-url file-or-url) | |
367 | (guix-build-log-mode)) | |
368 | ||
19a9c6f4 AK |
369 | ;;;###autoload |
370 | (add-hook 'shell-mode-hook 'guix-build-log-minor-mode-activate-maybe) | |
371 | ||
0048552d AK |
372 | ;;;###autoload |
373 | (add-to-list 'auto-mode-alist | |
374 | ;; Regexp for log files (usually placed in /var/log/guix/...) | |
375 | (cons (rx "/guix/drvs/" (= 2 alnum) "/" (= 30 alnum) | |
376 | "-" (+ (any alnum "-+.")) ".drv" string-end) | |
377 | 'guix-build-log-mode)) | |
378 | ||
34850cd5 AK |
379 | (provide 'guix-build-log) |
380 | ||
381 | ;;; guix-build-log.el ends here |