emacs/guix-build-log.el

   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
  27 (defgroup guix-build-log nil
  28   "Settings for `guix-build-log-mode'."
  29   :group 'guix)
  30
  31 (defgroup guix-build-log-faces nil
  32   "Faces for `guix-build-log-mode'."
  33   :group 'guix-build-log
  34   :group 'guix-faces)
  35
  36 (defface guix-build-log-title-head
  37   '((t :inherit font-lock-keyword-face))
  38   "Face for '@' symbol of a log title."
  39   :group 'guix-build-log-faces)
  40
  41 (defface guix-build-log-title-start
  42   '((t :inherit guix-build-log-title-head))
  43   "Face for a log title denoting a start of a process."
  44   :group 'guix-build-log-faces)
  45
  46 (defface guix-build-log-title-success
  47   '((t :inherit guix-build-log-title-head))
  48   "Face for a log title denoting a successful end of a process."
  49   :group 'guix-build-log-faces)
  50
  51 (defface guix-build-log-title-fail
  52   '((t :inherit error))
  53   "Face for a log title denoting a failed end of a process."
  54   :group 'guix-build-log-faces)
  55
  56 (defface guix-build-log-title-end
  57   '((t :inherit guix-build-log-title-head))
  58   "Face for a log title denoting an undefined end of a process."
  59   :group 'guix-build-log-faces)
  60
  61 (defface guix-build-log-phase-name
  62   '((t :inherit font-lock-function-name-face))
  63   "Face for a phase name."
  64   :group 'guix-build-log-faces)
  65
  66 (defface guix-build-log-phase-start
  67   '((default :weight bold)
  68     (((class grayscale) (background light)) :foreground "Gray90")
  69     (((class grayscale) (background dark))  :foreground "DimGray")
  70     (((class color) (min-colors 16) (background light))
  71      :foreground "DarkGreen")
  72     (((class color) (min-colors 16) (background dark))
  73      :foreground "LimeGreen")
  74     (((class color) (min-colors 8)) :foreground "green"))
  75   "Face for the start line of a phase."
  76   :group 'guix-build-log-faces)
  77
  78 (defface guix-build-log-phase-end
  79   '((((class grayscale) (background light)) :foreground "Gray90")
  80     (((class grayscale) (background dark))  :foreground "DimGray")
  81     (((class color) (min-colors 16) (background light))
  82      :foreground "ForestGreen")
  83     (((class color) (min-colors 16) (background dark))
  84      :foreground "LightGreen")
  85     (((class color) (min-colors 8)) :foreground "green")
  86     (t :weight bold))
  87   "Face for the end line of a phase."
  88   :group 'guix-build-log-faces)
  89
  90 (defface guix-build-log-phase-success
  91   '((t))
  92   "Face for the 'succeeded' word of a phase line."
  93   :group 'guix-build-log-faces)
  94
  95 (defface guix-build-log-phase-fail
  96   '((t :inherit error))
  97   "Face for the 'failed' word of a phase line."
  98   :group 'guix-build-log-faces)
  99
 100 (defface guix-build-log-phase-seconds
 101   '((t :inherit font-lock-constant-face))
 102   "Face for the number of seconds for a phase."
 103   :group 'guix-build-log-faces)
 104
 105 (defcustom guix-build-log-mode-hook
 106   ;; Not using `compilation-minor-mode' because it rebinds some standard
 107   ;; keys, including M-n/M-p.
 108   '(compilation-shell-minor-mode view-mode)
 109   "Hook run after `guix-build-log-mode' is entered."
 110   :type 'hook
 111   :group 'guix-build-log)
 112
 113 (defvar guix-build-log-phase-name-regexp "`\\([^']+\\)'"
 114   "Regexp for a phase name.")
 115
 116 (defvar guix-build-log-phase-start-regexp
 117   (concat "^starting phase " guix-build-log-phase-name-regexp)
 118   "Regexp for the start line of a 'build' phase.")
 119
 120 (defun guix-build-log-title-regexp (&optional state)
 121   "Return regexp for the log title.
 122 STATE is a symbol denoting a state of the title.  It should be
 123 `start', `fail', `success' or `nil' (for a regexp matching any
 124 state)."
 125   (let* ((word-rx (rx (1+ (any word "-"))))
 126          (state-rx (cond ((eq state 'start)   (concat word-rx "started"))
 127                          ((eq state 'success) (concat word-rx "succeeded"))
 128                          ((eq state 'fail)    (concat word-rx "failed"))
 129                          (t word-rx))))
 130     (rx-to-string
 131      `(and bol (group "@") " " (group (regexp ,state-rx)))
 132      t)))
 133
 134 (defun guix-build-log-phase-end-regexp (&optional state)
 135   "Return regexp for the end line of a 'build' phase.
 136 STATE is a symbol denoting how a build phase was ended.  It should be
 137 `fail', `success' or `nil' (for a regexp matching any state)."
 138   (let ((state-rx (cond ((eq state 'success) "succeeded")
 139                         ((eq state 'fail)    "failed")
 140                         (t (regexp-opt '("succeeded" "failed"))))))
 141     (rx-to-string
 142      `(and bol "phase " (regexp ,guix-build-log-phase-name-regexp)
 143            " " (group (regexp ,state-rx)) " after "
 144            (group (1+ digit)) " seconds")
 145      t)))
 146
 147 (defvar guix-build-log-phase-end-regexp
 148   ;; For efficiency, it is better to have a regexp for the general line
 149   ;; of the phase end, then to call the function all the time.
 150   (guix-build-log-phase-end-regexp)
 151   "Regexp for the end line of a 'build' phase.")
 152
 153 (defvar guix-build-log-font-lock-keywords
 154   `((,(guix-build-log-title-regexp 'start)
 155      (1 'guix-build-log-title-head)
 156      (2 'guix-build-log-title-start))
 157     (,(guix-build-log-title-regexp 'success)
 158      (1 'guix-build-log-title-head)
 159      (2 'guix-build-log-title-success))
 160     (,(guix-build-log-title-regexp 'fail)
 161      (1 'guix-build-log-title-head)
 162      (2 'guix-build-log-title-fail))
 163     (,(guix-build-log-title-regexp)
 164      (1 'guix-build-log-title-head)
 165      (2 'guix-build-log-title-end))
 166     (,guix-build-log-phase-start-regexp
 167      (0 'guix-build-log-phase-start)
 168      (1 'guix-build-log-phase-name prepend))
 169     (,(guix-build-log-phase-end-regexp 'success)
 170      (0 'guix-build-log-phase-end)
 171      (1 'guix-build-log-phase-name prepend)
 172      (2 'guix-build-log-phase-success prepend)
 173      (3 'guix-build-log-phase-seconds prepend))
 174     (,(guix-build-log-phase-end-regexp 'fail)
 175      (0 'guix-build-log-phase-end)
 176      (1 'guix-build-log-phase-name prepend)
 177      (2 'guix-build-log-phase-fail prepend)
 178      (3 'guix-build-log-phase-seconds prepend)))
 179   "A list of `font-lock-keywords' for `guix-build-log-mode'.")
 180
 181 (defvar guix-build-log-mode-map
 182   (let ((map (make-sparse-keymap)))
 183     (set-keymap-parent map special-mode-map)
 184     (define-key map (kbd "M-n") 'guix-build-log-next-phase)
 185     (define-key map (kbd "M-p") 'guix-build-log-previous-phase)
 186     (define-key map (kbd "TAB") 'guix-build-log-phase-toggle)
 187     (define-key map (kbd "<tab>") 'guix-build-log-phase-toggle)
 188     (define-key map (kbd "<backtab>") 'guix-build-log-phase-toggle-all)
 189     (define-key map [(shift tab)] 'guix-build-log-phase-toggle-all)
 190     map)
 191   "Keymap for `guix-build-log-mode' buffers.")
 192
 193 (defun guix-build-log-phase-start (&optional with-header?)
 194   "Return the start point of the current build phase.
 195 If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header.
 196 Return nil, if there is no phase start before the current point."
 197   (save-excursion
 198     (end-of-line)
 199     (when (re-search-backward guix-build-log-phase-start-regexp nil t)
 200       (unless with-header? (end-of-line))
 201       (point))))
 202
 203 (defun guix-build-log-phase-end ()
 204   "Return the end point of the current build phase."
 205   (save-excursion
 206     (beginning-of-line)
 207     (when (re-search-forward guix-build-log-phase-end-regexp nil t)
 208       (point))))
 209
 210 (defun guix-build-log-phase-hide ()
 211   "Hide the body of the current build phase."
 212   (interactive)
 213   (let ((beg (guix-build-log-phase-start))
 214         (end (guix-build-log-phase-end)))
 215     (when (and beg end)
 216       ;; If not on the header line, move to it.
 217       (when (and (> (point) beg)
 218                  (< (point) end))
 219         (goto-char (guix-build-log-phase-start t)))
 220       (remove-overlays beg end 'invisible t)
 221       (let ((o (make-overlay beg end)))
 222         (overlay-put o 'evaporate t)
 223         (overlay-put o 'invisible t)))))
 224
 225 (defun guix-build-log-phase-show ()
 226   "Show the body of the current build phase."
 227   (interactive)
 228   (let ((beg (guix-build-log-phase-start))
 229         (end (guix-build-log-phase-end)))
 230     (when (and beg end)
 231       (remove-overlays beg end 'invisible t))))
 232
 233 (defun guix-build-log-phase-hidden-p ()
 234   "Return non-nil, if the body of the current build phase is hidden."
 235   (let ((beg (guix-build-log-phase-start)))
 236     (and beg
 237          (cl-some (lambda (o)
 238                     (overlay-get o 'invisible))
 239                   (overlays-at beg)))))
 240
 241 (defun guix-build-log-phase-toggle-function ()
 242   "Return a function to toggle the body of the current build phase."
 243   (if (guix-build-log-phase-hidden-p)
 244       #'guix-build-log-phase-show
 245     #'guix-build-log-phase-hide))
 246
 247 (defun guix-build-log-phase-toggle ()
 248   "Show/hide the body of the current build phase."
 249   (interactive)
 250   (funcall (guix-build-log-phase-toggle-function)))
 251
 252 (defun guix-build-log-phase-toggle-all ()
 253   "Show/hide the bodies of all build phases."
 254   (interactive)
 255   (save-excursion
 256     ;; Some phases may be hidden, and some shown.  Whether to hide or to
 257     ;; show them, it is determined by the state of the first phase here.
 258     (goto-char (point-min))
 259     (guix-build-log-next-phase)
 260     (let ((fun (guix-build-log-phase-toggle-function)))
 261       (while (re-search-forward guix-build-log-phase-start-regexp nil t)
 262         (funcall fun)))))
 263
 264 (defun guix-build-log-next-phase (&optional arg)
 265   "Move to the next build phase.
 266 With ARG, do it that many times.  Negative ARG means move
 267 backward."
 268   (interactive "^p")
 269   (if arg
 270       (when (zerop arg) (user-error "Try again"))
 271     (setq arg 1))
 272   (let ((search-fun (if (> arg 0)
 273                         #'re-search-forward
 274                       #'re-search-backward))
 275         (n (abs arg))
 276         found last-found)
 277     (save-excursion
 278       (end-of-line (if (> arg 0) 1 0))  ; skip the current line
 279       (while (and (not (zerop n))
 280                   (setq found
 281                         (funcall search-fun
 282                                  guix-build-log-phase-start-regexp
 283                                  nil t)))
 284         (setq n (1- n)
 285               last-found found)))
 286     (when last-found
 287       (goto-char last-found)
 288       (forward-line 0))
 289     (or found
 290         (user-error (if (> arg 0)
 291                         "No next build phase"
 292                       "No previous build phase")))))
 293
 294 (defun guix-build-log-previous-phase (&optional arg)
 295   "Move to the previous build phase.
 296 With ARG, do it that many times.  Negative ARG means move
 297 forward."
 298   (interactive "^p")
 299   (guix-build-log-next-phase (- (or arg 1))))
 300
 301 ;;;###autoload
 302 (define-derived-mode guix-build-log-mode special-mode
 303   "Guix-Build-Log"
 304   "Major mode for viewing Guix build logs.
 305
 306 \\{guix-build-log-mode-map}"
 307   (setq font-lock-defaults '(guix-build-log-font-lock-keywords t)))
 308
 309 ;;;###autoload
 310 (define-minor-mode guix-build-log-minor-mode
 311   "Toggle Guix Build Log minor mode.
 312
 313 With a prefix argument ARG, enable Guix Build Log minor mode if
 314 ARG is positive, and disable it otherwise.  If called from Lisp,
 315 enable the mode if ARG is omitted or nil.
 316
 317 When Guix Build Log minor mode is enabled, it highlights build
 318 log in the current buffer.  This mode can be enabled
 319 programmatically using hooks:
 320
 321   (add-hook 'shell-mode-hook 'guix-build-log-minor-mode)"
 322   :init-value nil
 323   :lighter " Guix-Build-Log"
 324   :group 'guix-build-log
 325   (if guix-build-log-minor-mode
 326       (font-lock-add-keywords nil guix-build-log-font-lock-keywords)
 327     (font-lock-remove-keywords nil guix-build-log-font-lock-keywords))
 328   (when font-lock-mode
 329     (font-lock-fontify-buffer)))
 330
 331 (provide 'guix-build-log)
 332
 333 ;;; guix-build-log.el ends here