emacs/guix-base.el

   1 ;;; guix-base.el --- Common definitions   -*- lexical-binding: t -*-
   2
   3 ;; Copyright © 2014, 2015, 2016 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 some base and common definitions for guix.el
  23 ;; package.
  24
  25 ;;; Code:
  26
  27 (require 'cl-lib)
  28 (require 'guix-backend)
  29 (require 'guix-guile)
  30 (require 'guix-read)
  31 (require 'guix-utils)
  32 (require 'guix-ui)
  33 (require 'guix-profiles)
  34
  35 (defgroup guix nil
  36   "Settings for Guix package manager and friends."
  37   :prefix "guix-"
  38   :group 'external)
  39
  40 (defgroup guix-faces nil
  41   "Guix faces."
  42   :group 'guix
  43   :group 'faces)
  44
  45 (defun guix-package-name-specification (name version &optional output)
  46   "Return Guix package specification by its NAME, VERSION and OUTPUT."
  47   (concat name "@" version
  48           (when output (concat ":" output))))
  49
  50 \f
  51 ;;; Location of profiles and manifests
  52
  53 (defun guix-generation-file (profile generation)
  54   "Return the file name of a PROFILE's GENERATION."
  55   (format "%s-%s-link" profile generation))
  56
  57 (defun guix-packages-profile (profile &optional generation system?)
  58   "Return a directory where packages are installed for the
  59 PROFILE's GENERATION.
  60
  61 If SYSTEM? is non-nil, then PROFILE is considered to be a system
  62 profile.  Unlike usual profiles, for a system profile, packages
  63 are placed in 'profile' subdirectory."
  64   (let ((profile (if generation
  65                      (guix-generation-file profile generation)
  66                    profile)))
  67     (if system?
  68         (expand-file-name "profile" profile)
  69       profile)))
  70
  71 (defun guix-manifest-file (profile &optional generation system?)
  72   "Return the file name of a PROFILE's manifest.
  73 See `guix-packages-profile'."
  74   (expand-file-name "manifest"
  75                     (guix-packages-profile profile generation system?)))
  76
  77 \f
  78 ;;; Actions on packages and generations
  79
  80 (defface guix-operation-option-key
  81   '((t :inherit font-lock-warning-face))
  82   "Face used for the keys of operation options."
  83   :group 'guix-faces)
  84
  85 (defcustom guix-operation-confirm t
  86   "If nil, do not prompt to confirm an operation."
  87   :type 'boolean
  88   :group 'guix)
  89
  90 (defcustom guix-use-substitutes t
  91   "If non-nil, use substitutes for the Guix packages."
  92   :type 'boolean
  93   :group 'guix)
  94
  95 (defvar guix-dry-run nil
  96   "If non-nil, do not perform the real actions, just simulate.")
  97
  98 (defvar guix-temp-buffer-name " *Guix temp*"
  99   "Name of a buffer used for displaying info before executing operation.")
 100
 101 (defvar guix-operation-option-true-string "yes"
 102   "String displayed in the mode-line when operation option is t.")
 103
 104 (defvar guix-operation-option-false-string "no "
 105   "String displayed in the mode-line when operation option is nil.")
 106
 107 (defvar guix-operation-option-separator "  |  "
 108   "String used in the mode-line to separate operation options.")
 109
 110 (defvar guix-operation-options
 111   '((?s "substitutes" guix-use-substitutes)
 112     (?d "dry-run"     guix-dry-run))
 113   "List of available operation options.
 114 Each element of the list has a form:
 115
 116   (KEY NAME VARIABLE)
 117
 118 KEY is a character that may be pressed during confirmation to
 119 toggle the option.
 120 NAME is a string displayed in the mode-line.
 121 VARIABLE is a name of an option variable.")
 122
 123 (defun guix-operation-option-by-key (key)
 124   "Return operation option by KEY (character)."
 125   (assq key guix-operation-options))
 126
 127 (defun guix-operation-option-key (option)
 128   "Return key (character) of the operation OPTION."
 129   (car option))
 130
 131 (defun guix-operation-option-name (option)
 132   "Return name of the operation OPTION."
 133   (nth 1 option))
 134
 135 (defun guix-operation-option-variable (option)
 136   "Return name of the variable of the operation OPTION."
 137   (nth 2 option))
 138
 139 (defun guix-operation-option-value (option)
 140   "Return boolean value of the operation OPTION."
 141   (symbol-value (guix-operation-option-variable option)))
 142
 143 (defun guix-operation-option-string-value (option)
 144   "Convert boolean value of the operation OPTION to string and return it."
 145   (if (guix-operation-option-value option)
 146       guix-operation-option-true-string
 147     guix-operation-option-false-string))
 148
 149 (defun guix-operation-prompt (&optional prompt)
 150   "Prompt a user for continuing the current operation.
 151 Return non-nil, if the operation should be continued; nil otherwise.
 152 Ask a user with PROMPT for continuing an operation."
 153   (let* ((option-keys (mapcar #'guix-operation-option-key
 154                               guix-operation-options))
 155          (keys (append '(?y ?n) option-keys))
 156          (prompt (concat (propertize (or prompt "Continue operation?")
 157                                      'face 'minibuffer-prompt)
 158                          " ("
 159                          (mapconcat
 160                           (lambda (key)
 161                             (propertize (string key)
 162                                         'face 'guix-operation-option-key))
 163                           keys
 164                           ", ")
 165                          ") ")))
 166     (let ((mode-line mode-line-format))
 167       (prog1 (guix-operation-prompt-1 prompt keys)
 168         (setq mode-line-format mode-line)
 169         ;; Clear the minibuffer after prompting.
 170         (message "")))))
 171
 172 (defun guix-operation-prompt-1 (prompt keys)
 173   "This function is internal for `guix-operation-prompt'."
 174   (guix-operation-set-mode-line)
 175   (let ((key (read-char-choice prompt (cons ?\C-g keys) t)))
 176     (cl-case key
 177       (?y t)
 178       ((?n ?\C-g) nil)
 179       (t (let* ((option (guix-operation-option-by-key key))
 180                 (var (guix-operation-option-variable option)))
 181            (set var (not (symbol-value var)))
 182            (guix-operation-prompt-1 prompt keys))))))
 183
 184 (defun guix-operation-set-mode-line ()
 185   "Display operation options in the mode-line of the current buffer."
 186   (setq mode-line-format
 187         (concat (propertize " Options:   "
 188                             'face 'mode-line-buffer-id)
 189                 (mapconcat
 190                  (lambda (option)
 191                    (let ((key  (guix-operation-option-key option))
 192                          (name (guix-operation-option-name option))
 193                          (val  (guix-operation-option-string-value option)))
 194                      (concat name
 195                              " ("
 196                              (propertize (string key)
 197                                          'face 'guix-operation-option-key)
 198                              "): " val)))
 199                  guix-operation-options
 200                  guix-operation-option-separator)))
 201   (force-mode-line-update))
 202
 203 (defun guix-package-source-path (package-id)
 204   "Return a store file path to a source of a package PACKAGE-ID."
 205   (message "Calculating the source derivation ...")
 206   (guix-eval-read
 207    (guix-make-guile-expression
 208     'package-source-path package-id)))
 209
 210 (defun guix-package-store-path (package-id)
 211   "Return a list of store directories of outputs of package PACKAGE-ID."
 212   (message "Calculating the package derivation ...")
 213   (guix-eval-read
 214    (guix-make-guile-expression
 215     'package-store-path package-id)))
 216
 217 (defvar guix-after-source-download-hook nil
 218   "Hook run after successful performing a 'source-download' operation.")
 219
 220 (defun guix-package-source-build-derivation (package-id &optional prompt)
 221   "Build source derivation of a package PACKAGE-ID.
 222 Ask a user with PROMPT for continuing an operation."
 223   (when (or (not guix-operation-confirm)
 224             (guix-operation-prompt (or prompt
 225                                        "Build the source derivation?")))
 226     (guix-eval-in-repl
 227      (guix-make-guile-expression
 228       'package-source-build-derivation
 229       package-id
 230       :use-substitutes? (or guix-use-substitutes 'f)
 231       :dry-run? (or guix-dry-run 'f))
 232      nil 'source-download)))
 233
 234 (defun guix-build-package (package-id &optional prompt)
 235   "Build package with PACKAGE-ID.
 236 Ask a user with PROMPT for continuing the build operation."
 237   (when (or (not guix-operation-confirm)
 238             (guix-operation-prompt (or prompt "Build package?")))
 239     (guix-eval-in-repl
 240      (format (concat ",run-in-store "
 241                      "(build-package (package-by-id %d)"
 242                      " #:use-substitutes? %s"
 243                      " #:dry-run? %s)")
 244              package-id
 245              (guix-guile-boolean guix-use-substitutes)
 246              (guix-guile-boolean guix-dry-run)))))
 247
 248 ;;;###autoload
 249 (defun guix-apply-manifest (profile file &optional operation-buffer)
 250   "Apply manifest from FILE to PROFILE.
 251 This function has the same meaning as 'guix package --manifest' command.
 252 See Info node `(guix) Invoking guix package' for details.
 253
 254 Interactively, use the current profile and prompt for manifest
 255 FILE.  With a prefix argument, also prompt for PROFILE."
 256   (interactive
 257    (let* ((current-profile (guix-ui-current-profile))
 258           (profile (if current-prefix-arg
 259                        (guix-profile-prompt)
 260                      (or current-profile guix-current-profile)))
 261           (file (read-file-name "File with manifest: "))
 262           (buffer (and current-profile (current-buffer))))
 263      (list profile file buffer)))
 264   (when (or (not guix-operation-confirm)
 265             (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? "
 266                               file profile)))
 267     (guix-eval-in-repl
 268      (guix-make-guile-expression
 269       'guix-command
 270       "package"
 271       (concat "--profile="  (expand-file-name profile))
 272       (concat "--manifest=" (expand-file-name file)))
 273      operation-buffer)))
 274
 275 \f
 276 ;;; Executing guix commands
 277
 278 (defcustom guix-run-in-shell-function #'guix-run-in-shell
 279   "Function used to run guix command.
 280 The function is called with a single argument - a command line string."
 281   :type '(choice (function-item guix-run-in-shell)
 282                  (function-item guix-run-in-eshell)
 283                  (function :tag "Other function"))
 284   :group 'guix)
 285
 286 (defcustom guix-shell-buffer-name "*shell*"
 287   "Default name of a shell buffer used for running guix commands."
 288   :type 'string
 289   :group 'guix)
 290
 291 (declare-function comint-send-input "comint" t)
 292
 293 (defun guix-run-in-shell (string)
 294   "Run command line STRING in `guix-shell-buffer-name' buffer."
 295   (shell guix-shell-buffer-name)
 296   (goto-char (point-max))
 297   (insert string)
 298   (comint-send-input))
 299
 300 (declare-function eshell-send-input "esh-mode" t)
 301
 302 (defun guix-run-in-eshell (string)
 303   "Run command line STRING in eshell buffer."
 304   (eshell)
 305   (goto-char (point-max))
 306   (insert string)
 307   (eshell-send-input))
 308
 309 (defun guix-run-command-in-shell (args)
 310   "Execute 'guix ARGS ...' command in a shell buffer."
 311   (funcall guix-run-in-shell-function
 312            (guix-command-string args)))
 313
 314 (defun guix-run-command-in-repl (args)
 315   "Execute 'guix ARGS ...' command in Guix REPL."
 316   (guix-eval-in-repl
 317    (apply #'guix-make-guile-expression
 318           'guix-command args)))
 319
 320 (defun guix-command-output (args)
 321   "Return string with 'guix ARGS ...' output."
 322   (cl-multiple-value-bind (output error)
 323       (guix-eval (apply #'guix-make-guile-expression
 324                         'guix-command-output args))
 325     ;; Remove trailing new space from the error string.
 326     (message (replace-regexp-in-string "\n\\'" "" (read error)))
 327     (read output)))
 328
 329 (defun guix-help-string (&optional commands)
 330   "Return string with 'guix COMMANDS ... --help' output."
 331   (guix-eval-read
 332    (apply #'guix-make-guile-expression
 333           'help-string commands)))
 334
 335 \f
 336 ;;; Pull
 337
 338 (defcustom guix-update-after-pull t
 339   "If non-nil, update Guix buffers after performing \\[guix-pull]."
 340   :type 'boolean
 341   :group 'guix)
 342
 343 (defvar guix-after-pull-hook
 344   '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull)
 345   "Hook run after successful performing `guix-pull' operation.")
 346
 347 (defun guix-restart-repl-after-pull ()
 348   "Restart Guix REPL after `guix-pull' operation."
 349   (guix-repl-exit)
 350   (guix-start-process-maybe
 351    "Restarting Guix REPL after pull operation ..."))
 352
 353 (defun guix-update-buffers-maybe-after-pull ()
 354   "Update buffers depending on `guix-update-after-pull'."
 355   (when guix-update-after-pull
 356     (mapc #'guix-ui-update-buffer
 357           ;; No need to update "generation" buffers.
 358           (guix-ui-buffers '(guix-package-list-mode
 359                              guix-package-info-mode
 360                              guix-output-list-mode
 361                              guix-output-info-mode)))
 362     (message "Guix buffers have been updated.")))
 363
 364 ;;;###autoload
 365 (defun guix-pull (&optional verbose)
 366   "Run Guix pull operation.
 367 If VERBOSE is non-nil (with prefix argument), produce verbose output."
 368   (interactive "P")
 369   (let ((args (and verbose '("--verbose"))))
 370     (guix-eval-in-repl
 371      (apply #'guix-make-guile-expression
 372             'guix-command "pull" args)
 373      nil 'pull)))
 374
 375 (provide 'guix-base)
 376
 377 ;;; guix-base.el ends here