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 (require 'guix-utils)
  28
  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
 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
 113 (defcustom guix-build-log-mode-hook '()
 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 "
 149            (group (1+ (or digit "."))) " seconds")
 150      t)))
 151
 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
 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
 186 (defvar guix-build-log-common-map
 187   (let ((map (make-sparse-keymap)))
 188     (define-key map (kbd "M-n") 'guix-build-log-next-phase)
 189     (define-key map (kbd "M-p") 'guix-build-log-previous-phase)
 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)
 194     map)
 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))
 204     (define-key map (kbd "c") 'compilation-shell-minor-mode)
 205     (define-key map (kbd "v") 'view-mode)
 206     map)
 207   "Keymap for `guix-build-log-mode' buffers.")
 208
 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
 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))
 281     (let ((fun (save-excursion
 282                  (re-search-forward guix-build-log-phase-start-regexp nil t)
 283                  (guix-build-log-phase-toggle-function))))
 284       (while (re-search-forward guix-build-log-phase-start-regexp nil t)
 285         (funcall fun)))))
 286
 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
 344   (add-hook 'shell-mode-hook 'guix-build-log-minor-mode)
 345
 346 \\{guix-build-log-minor-mode-map}"
 347   :init-value nil
 348   :lighter " Guix-Build-Log"
 349   :keymap guix-build-log-minor-mode-map
 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
 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
 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
 369 ;;;###autoload
 370 (add-hook 'shell-mode-hook 'guix-build-log-minor-mode-activate-maybe)
 371
 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
 379 (provide 'guix-build-log)
 380
 381 ;;; guix-build-log.el ends here