emacs/guix-devel.el

   1 ;;; guix-devel.el --- Development tools   -*- 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 commands useful for developing Guix (or even
  23 ;; arbitrary Guile code) with Geiser.
  24
  25 ;;; Code:
  26
  27 (require 'lisp-mode)
  28 (require 'guix-guile)
  29 (require 'guix-geiser)
  30 (require 'guix-utils)
  31 (require 'guix-base)
  32
  33 (defgroup guix-devel nil
  34   "Settings for Guix development utils."
  35   :group 'guix)
  36
  37 (defgroup guix-devel-faces nil
  38   "Faces for `guix-devel-mode'."
  39   :group 'guix-devel
  40   :group 'guix-faces)
  41
  42 (defface guix-devel-modify-phases-keyword
  43   '((t :inherit font-lock-preprocessor-face))
  44   "Face for a `modify-phases' keyword ('delete', 'replace', etc.)."
  45   :group 'guix-devel-faces)
  46
  47 (defface guix-devel-gexp-symbol
  48   '((t :inherit font-lock-keyword-face))
  49   "Face for gexp symbols ('#~', '#$', etc.).
  50 See Info node `(guix) G-Expressions'."
  51   :group 'guix-devel-faces)
  52
  53 (defcustom guix-devel-activate-mode t
  54   "If non-nil, then `guix-devel-mode' is automatically activated
  55 in Scheme buffers."
  56   :type 'boolean
  57   :group 'guix-devel)
  58
  59 (defun guix-devel-use-modules (&rest modules)
  60   "Use guile MODULES."
  61   (apply #'guix-geiser-call "use-modules" modules))
  62
  63 (defun guix-devel-use-module (&optional module)
  64   "Use guile MODULE in the current Geiser REPL.
  65 MODULE is a string with the module name - e.g., \"(ice-9 match)\".
  66 Interactively, use the module defined by the current scheme file."
  67   (interactive (list (guix-guile-current-module)))
  68   (guix-devel-use-modules module)
  69   (message "Using %s module." module))
  70
  71 (defun guix-devel-copy-module-as-kill ()
  72   "Put the name of the current guile module into `kill-ring'."
  73   (interactive)
  74   (guix-copy-as-kill (guix-guile-current-module)))
  75
  76 (defun guix-devel-setup-repl (&optional repl)
  77   "Setup REPL for using `guix-devel-...' commands."
  78   (guix-devel-use-modules "(guix monad-repl)"
  79                           "(guix scripts)"
  80                           "(guix store)"
  81                           "(guix ui)")
  82   ;; Without this workaround, the warning/build output disappears.  See
  83   ;; <https://github.com/jaor/geiser/issues/83> for details.
  84   (guix-geiser-eval-in-repl-synchronously
  85    "(begin
  86       (guix-warning-port (current-warning-port))
  87       (current-build-output-port (current-error-port)))"
  88    repl 'no-history 'no-display))
  89
  90 (defvar guix-devel-repl-processes nil
  91   "List of REPL processes configured by `guix-devel-setup-repl'.")
  92
  93 (defun guix-devel-setup-repl-maybe (&optional repl)
  94   "Setup (if needed) REPL for using `guix-devel-...' commands."
  95   (let ((process (get-buffer-process (or repl (guix-geiser-repl)))))
  96     (when (and process
  97                (not (memq process guix-devel-repl-processes)))
  98       (guix-devel-setup-repl repl)
  99       (push process guix-devel-repl-processes))))
 100
 101 (defmacro guix-devel-with-definition (def-var &rest body)
 102   "Run BODY with the current guile definition bound to DEF-VAR.
 103 Bind DEF-VAR variable to the name of the current top-level
 104 definition, setup the current REPL, use the current module, and
 105 run BODY."
 106   (declare (indent 1) (debug (symbolp body)))
 107   `(let ((,def-var (guix-guile-current-definition)))
 108      (guix-devel-setup-repl-maybe)
 109      (guix-devel-use-modules (guix-guile-current-module))
 110      ,@body))
 111
 112 (defun guix-devel-build-package-definition ()
 113   "Build a package defined by the current top-level variable definition."
 114   (interactive)
 115   (guix-devel-with-definition def
 116     (when (or (not guix-operation-confirm)
 117               (guix-operation-prompt (format "Build '%s'?" def)))
 118       (guix-geiser-eval-in-repl
 119        (concat ",run-in-store "
 120                (guix-guile-make-call-expression
 121                 "build-package" def
 122                 "#:use-substitutes?" (guix-guile-boolean
 123                                       guix-use-substitutes)
 124                 "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
 125
 126 (defun guix-devel-build-package-source ()
 127   "Build the source of the current package definition."
 128   (interactive)
 129   (guix-devel-with-definition def
 130     (when (or (not guix-operation-confirm)
 131               (guix-operation-prompt
 132                (format "Build '%s' package source?" def)))
 133       (guix-geiser-eval-in-repl
 134        (concat ",run-in-store "
 135                (guix-guile-make-call-expression
 136                 "build-package-source" def
 137                 "#:use-substitutes?" (guix-guile-boolean
 138                                       guix-use-substitutes)
 139                 "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
 140
 141 (defun guix-devel-lint-package ()
 142   "Check the current package.
 143 See Info node `(guix) Invoking guix lint' for details."
 144   (interactive)
 145   (guix-devel-with-definition def
 146     (guix-devel-use-modules "(guix scripts lint)")
 147     (when (or (not guix-operation-confirm)
 148               (y-or-n-p (format "Lint '%s' package?" def)))
 149       (guix-geiser-eval-in-repl
 150        (format "(run-checkers %s)" def)))))
 151
 152 \f
 153 ;;; Font-lock
 154
 155 (defvar guix-devel-modify-phases-keyword-regexp
 156   (rx (+ word))
 157   "Regexp for a 'modify-phases' keyword ('delete', 'replace', etc.).")
 158
 159 (defun guix-devel-modify-phases-font-lock-matcher (limit)
 160   "Find a 'modify-phases' keyword.
 161 This function is used as a MATCHER for `font-lock-keywords'."
 162   (ignore-errors
 163     (down-list)
 164     (or (re-search-forward guix-devel-modify-phases-keyword-regexp
 165                            limit t)
 166         (set-match-data nil))
 167     (up-list)
 168     t))
 169
 170 (defun guix-devel-modify-phases-font-lock-pre ()
 171   "Skip the next sexp, and return the end point of the current list.
 172 This function is used as a PRE-MATCH-FORM for `font-lock-keywords'
 173 to find 'modify-phases' keywords."
 174   (let ((in-comment? (nth 4 (syntax-ppss))))
 175     ;; If 'modify-phases' is commented, do not try to search for its
 176     ;; keywords.
 177     (unless in-comment?
 178       (ignore-errors (forward-sexp))
 179       (save-excursion (up-list) (point)))))
 180
 181 (defconst guix-devel-keywords
 182   '("call-with-compressed-output-port"
 183     "call-with-container"
 184     "call-with-decompressed-port"
 185     "call-with-derivation-narinfo"
 186     "call-with-derivation-substitute"
 187     "call-with-error-handling"
 188     "call-with-temporary-directory"
 189     "call-with-temporary-output-file"
 190     "define-enumerate-type"
 191     "define-gexp-compiler"
 192     "define-lift"
 193     "define-monad"
 194     "define-operation"
 195     "define-record-type*"
 196     "emacs-substitute-sexps"
 197     "emacs-substitute-variables"
 198     "mbegin"
 199     "mlet"
 200     "mlet*"
 201     "modify-services"
 202     "munless"
 203     "mwhen"
 204     "run-with-state"
 205     "run-with-store"
 206     "signature-case"
 207     "substitute*"
 208     "substitute-keyword-arguments"
 209     "test-assertm"
 210     "use-package-modules"
 211     "use-service-modules"
 212     "use-system-modules"
 213     "with-atomic-file-output"
 214     "with-atomic-file-replacement"
 215     "with-derivation-narinfo"
 216     "with-derivation-substitute"
 217     "with-directory-excursion"
 218     "with-error-handling"
 219     "with-monad"
 220     "with-mutex"
 221     "with-store"))
 222
 223 (defvar guix-devel-font-lock-keywords
 224   `((,(rx (or "#~" "#$" "#$@" "#+" "#+@")) .
 225      'guix-devel-gexp-symbol)
 226     (,(guix-guile-keyword-regexp (regexp-opt guix-devel-keywords))
 227      (1 'font-lock-keyword-face))
 228     (,(guix-guile-keyword-regexp "modify-phases")
 229      (1 'font-lock-keyword-face)
 230      (guix-devel-modify-phases-font-lock-matcher
 231       (guix-devel-modify-phases-font-lock-pre)
 232       nil
 233       (0 'guix-devel-modify-phases-keyword nil t))))
 234   "A list of `font-lock-keywords' for `guix-devel-mode'.")
 235
 236 \f
 237 ;;; Indentation
 238
 239 (defmacro guix-devel-scheme-indent (&rest rules)
 240   "Set `scheme-indent-function' according to RULES.
 241 Each rule should have a form (SYMBOL VALUE).  See `put' for details."
 242   (declare (indent 0))
 243   `(progn
 244      ,@(mapcar (lambda (rule)
 245                  `(put ',(car rule) 'scheme-indent-function ,(cadr rule)))
 246                rules)))
 247
 248 (defun guix-devel-indent-package (state indent-point normal-indent)
 249   "Indentation rule for 'package' form."
 250   (let* ((package-eol (line-end-position))
 251          (count (if (and (ignore-errors (down-list) t)
 252                          (< (point) package-eol)
 253                          (looking-at "inherit\\>"))
 254                     1
 255                   0)))
 256     (lisp-indent-specform count state indent-point normal-indent)))
 257
 258 (defun guix-devel-indent-modify-phases-keyword (count)
 259   "Return indentation function for 'modify-phases' keywords."
 260   (lambda (state indent-point normal-indent)
 261     (when (ignore-errors
 262             (goto-char (nth 1 state))   ; start of keyword sexp
 263             (backward-up-list)
 264             (looking-at "(modify-phases\\>"))
 265       (lisp-indent-specform count state indent-point normal-indent))))
 266
 267 (defalias 'guix-devel-indent-modify-phases-keyword-1
 268   (guix-devel-indent-modify-phases-keyword 1))
 269 (defalias 'guix-devel-indent-modify-phases-keyword-2
 270   (guix-devel-indent-modify-phases-keyword 2))
 271
 272 (guix-devel-scheme-indent
 273   (bag 0)
 274   (build-system 0)
 275   (call-with-compressed-output-port 2)
 276   (call-with-container 1)
 277   (call-with-decompressed-port 2)
 278   (call-with-error-handling 0)
 279   (container-excursion 1)
 280   (emacs-batch-edit-file 1)
 281   (emacs-batch-eval 0)
 282   (emacs-substitute-sexps 1)
 283   (emacs-substitute-variables 1)
 284   (file-system 0)
 285   (graft 0)
 286   (manifest-entry 0)
 287   (manifest-pattern 0)
 288   (mbegin 1)
 289   (mlet 2)
 290   (mlet* 2)
 291   (modify-phases 1)
 292   (modify-services 1)
 293   (munless 1)
 294   (mwhen 1)
 295   (operating-system 0)
 296   (origin 0)
 297   (package 'guix-devel-indent-package)
 298   (run-with-state 1)
 299   (run-with-store 1)
 300   (signature-case 1)
 301   (substitute* 1)
 302   (substitute-keyword-arguments 1)
 303   (test-assertm 1)
 304   (with-atomic-file-output 1)
 305   (with-derivation-narinfo 1)
 306   (with-derivation-substitute 2)
 307   (with-directory-excursion 1)
 308   (with-error-handling 0)
 309   (with-monad 1)
 310   (with-mutex 1)
 311   (with-store 1)
 312   (wrap-program 1)
 313
 314   ;; 'modify-phases' keywords:
 315   (replace    'guix-devel-indent-modify-phases-keyword-1)
 316   (add-after  'guix-devel-indent-modify-phases-keyword-2)
 317   (add-before 'guix-devel-indent-modify-phases-keyword-2))
 318
 319 \f
 320 (defvar guix-devel-keys-map
 321   (let ((map (make-sparse-keymap)))
 322     (define-key map (kbd "b") 'guix-devel-build-package-definition)
 323     (define-key map (kbd "s") 'guix-devel-build-package-source)
 324     (define-key map (kbd "l") 'guix-devel-lint-package)
 325     (define-key map (kbd "k") 'guix-devel-copy-module-as-kill)
 326     (define-key map (kbd "u") 'guix-devel-use-module)
 327     map)
 328   "Keymap with subkeys for `guix-devel-mode-map'.")
 329
 330 (defvar guix-devel-mode-map
 331   (let ((map (make-sparse-keymap)))
 332     (define-key map (kbd "C-c .") guix-devel-keys-map)
 333     map)
 334   "Keymap for `guix-devel-mode'.")
 335
 336 ;;;###autoload
 337 (define-minor-mode guix-devel-mode
 338   "Minor mode for `scheme-mode' buffers.
 339
 340 With a prefix argument ARG, enable the mode if ARG is positive,
 341 and disable it otherwise.  If called from Lisp, enable the mode
 342 if ARG is omitted or nil.
 343
 344 When Guix Devel mode is enabled, it provides the following key
 345 bindings:
 346
 347 \\{guix-devel-mode-map}"
 348   :init-value nil
 349   :lighter " Guix"
 350   :keymap guix-devel-mode-map
 351   (if guix-devel-mode
 352       (progn
 353         (setq-local font-lock-multiline t)
 354         (font-lock-add-keywords nil guix-devel-font-lock-keywords))
 355     (setq-local font-lock-multiline nil)
 356     (font-lock-remove-keywords nil guix-devel-font-lock-keywords))
 357   (when font-lock-mode
 358     (font-lock-fontify-buffer)))
 359
 360 ;;;###autoload
 361 (defun guix-devel-activate-mode-maybe ()
 362   "Activate `guix-devel-mode' depending on
 363 `guix-devel-activate-mode' variable."
 364   (when guix-devel-activate-mode
 365     (guix-devel-mode)))
 366
 367 \f
 368 (defvar guix-devel-emacs-font-lock-keywords
 369   (eval-when-compile
 370     `((,(rx "(" (group "guix-devel-with-definition") symbol-end) . 1))))
 371
 372 (font-lock-add-keywords 'emacs-lisp-mode
 373                         guix-devel-emacs-font-lock-keywords)
 374
 375 (provide 'guix-devel)
 376
 377 ;;; guix-devel.el ends here