emacs/guix-base.el

   1 ;;; guix-base.el --- Common definitions   -*- lexical-binding: t -*-
   2
   3 ;; Copyright © 2014 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 ;; List and info buffers have many common patterns that are defined
  26 ;; using `guix-define-buffer-type' macro from this file.
  27
  28 ;;; Code:
  29
  30 (require 'cl-lib)
  31 (require 'guix-profiles)
  32 (require 'guix-backend)
  33 (require 'guix-utils)
  34 (require 'guix-history)
  35 (require 'guix-messages)
  36
  37 \f
  38 ;;; Parameters of the entries
  39
  40 (defvar guix-param-titles
  41   '((package
  42      (id                . "ID")
  43      (name              . "Name")
  44      (version           . "Version")
  45      (source            . "Source")
  46      (license           . "License")
  47      (synopsis          . "Synopsis")
  48      (description       . "Description")
  49      (home-url          . "Home page")
  50      (outputs           . "Outputs")
  51      (inputs            . "Inputs")
  52      (native-inputs     . "Native inputs")
  53      (propagated-inputs . "Propagated inputs")
  54      (location          . "Location")
  55      (installed         . "Installed"))
  56     (installed
  57      (path              . "Installed path")
  58      (dependencies      . "Dependencies")
  59      (output            . "Output"))
  60     (output
  61      (id                . "ID")
  62      (name              . "Name")
  63      (version           . "Version")
  64      (source            . "Source")
  65      (license           . "License")
  66      (synopsis          . "Synopsis")
  67      (description       . "Description")
  68      (home-url          . "Home page")
  69      (output            . "Output")
  70      (inputs            . "Inputs")
  71      (native-inputs     . "Native inputs")
  72      (propagated-inputs . "Propagated inputs")
  73      (location          . "Location")
  74      (installed         . "Installed")
  75      (path              . "Installed path")
  76      (dependencies      . "Dependencies"))
  77     (generation
  78      (id                . "ID")
  79      (number            . "Number")
  80      (prev-number       . "Previous number")
  81      (current           . "Current")
  82      (path              . "Path")
  83      (time              . "Time")))
  84   "List for defining titles of entry parameters.
  85 Titles are used for displaying information about entries.
  86 Each element of the list has a form:
  87
  88   (ENTRY-TYPE . ((PARAM . TITLE) ...))")
  89
  90 (defun guix-get-param-title (entry-type param)
  91   "Return title of an ENTRY-TYPE entry parameter PARAM."
  92   (or (guix-get-key-val guix-param-titles
  93                         entry-type param)
  94       (prog1 (symbol-name param)
  95         (message "Couldn't find title for '%S %S'."
  96                  entry-type param))))
  97
  98 (defun guix-get-name-spec (name version &optional output)
  99   "Return Guix package specification by its NAME, VERSION and OUTPUT."
 100   (concat name "-" version
 101           (when output (concat ":" output))))
 102
 103 (defun guix-get-full-name (entry &optional output)
 104   "Return name specification of the package ENTRY and OUTPUT."
 105   (guix-get-name-spec (guix-get-key-val entry 'name)
 106                       (guix-get-key-val entry 'version)
 107                       output))
 108
 109 (defun guix-entry-to-specification (entry)
 110   "Return name specification by the package or output ENTRY."
 111   (guix-get-name-spec (guix-get-key-val entry 'name)
 112                       (guix-get-key-val entry 'version)
 113                       (guix-get-key-val entry 'output)))
 114
 115 (defun guix-entries-to-specifications (entries)
 116   "Return name specifications by the package or output ENTRIES."
 117   (cl-remove-duplicates (mapcar #'guix-entry-to-specification entries)
 118                         :test #'string=))
 119
 120 (defun guix-get-installed-outputs (entry)
 121   "Return list of installed outputs for the package ENTRY."
 122   (mapcar (lambda (installed-entry)
 123             (guix-get-key-val installed-entry 'output))
 124           (guix-get-key-val entry 'installed)))
 125
 126 (defun guix-get-entry-by-id (id entries)
 127   "Return entry from ENTRIES by entry ID."
 128   (cl-find-if (lambda (entry)
 129                 (equal id (guix-get-key-val entry 'id)))
 130               entries))
 131
 132 (defun guix-get-package-id-and-output-by-output-id (oid)
 133   "Return list (PACKAGE-ID OUTPUT) by output id OID."
 134   (cl-multiple-value-bind (pid-str output)
 135       (split-string oid ":")
 136     (let ((pid (string-to-number pid-str)))
 137       (list (if (= 0 pid) pid-str pid)
 138             output))))
 139
 140 \f
 141 ;;; Location of the packages
 142
 143 (defvar guix-directory nil
 144   "Default Guix directory.
 145 If it is not set by a user, it is set after starting Guile REPL.
 146 This directory is used to define location of the packages.")
 147
 148 (defun guix-set-directory ()
 149   "Set `guix-directory' if needed."
 150   (or guix-directory
 151       (setq guix-directory
 152             (guix-eval-read "%guix-dir"))))
 153
 154 (add-hook 'guix-after-start-repl-hook 'guix-set-directory)
 155
 156 (defun guix-find-location (location)
 157   "Go to LOCATION of a package.
 158 LOCATION is a string of the form:
 159
 160   \"PATH:LINE:COLUMN\"
 161
 162 If PATH is relative, it is considered to be relative to
 163 `guix-directory'."
 164   (cl-multiple-value-bind (path line col)
 165       (split-string location ":")
 166     (let ((file (expand-file-name path guix-directory))
 167           (line (string-to-number line))
 168           (col  (string-to-number col)))
 169       (find-file file)
 170       (goto-char (point-min))
 171       (forward-line (- line 1))
 172       (move-to-column col)
 173       (recenter 1))))
 174
 175 (defun guix-edit-package (id)
 176   "Edit (go to location of) package with ID."
 177   (let ((loc (guix-eval-read (guix-make-guile-expression
 178                               'package-location-string id))))
 179     (if loc
 180         (guix-find-location loc)
 181       (message "Couldn't find package location."))))
 182
 183 \f
 184 ;;; Buffers and auto updating.
 185
 186 (defcustom guix-update-after-operation 'current
 187   "Define what information to update after executing an operation.
 188
 189 After successful executing an operation in the Guix REPL (for
 190 example after installing a package), information in Guix buffers
 191 will or will not be automatically updated depending on a value of
 192 this variable.
 193
 194 If nil, update nothing (do not revert any buffer).
 195 If `current', update the buffer from which an operation was performed.
 196 If `all', update all Guix buffers (not recommended)."
 197   :type '(choice (const :tag "Do nothing" nil)
 198                  (const :tag "Update operation buffer" current)
 199                  (const :tag "Update all Guix buffers" all))
 200   :group 'guix)
 201
 202 (defcustom guix-buffer-name-function #'guix-buffer-name-default
 203   "Function used to define name of a buffer for displaying information.
 204 The function is called with 4 arguments: PROFILE, BUFFER-TYPE,
 205 ENTRY-TYPE, SEARCH-TYPE.  See `guix-get-entries' for the meaning
 206 of the arguments."
 207   :type '(choice (function-item guix-buffer-name-default)
 208                  (function-item guix-buffer-name-simple)
 209                  (function :tag "Other function"))
 210   :group 'guix)
 211
 212 (defun guix-buffer-name-simple (_profile buffer-type entry-type
 213                                 &optional _search-type)
 214   "Return name of a buffer used for displaying information.
 215 The name is defined by `guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name'
 216 variable."
 217   (symbol-value
 218    (guix-get-symbol "buffer-name" buffer-type entry-type)))
 219
 220 (defun guix-buffer-name-default (profile buffer-type entry-type
 221                                  &optional _search-type)
 222   "Return name of a buffer used for displaying information.
 223 The name is almost the same as the one defined by
 224 `guix-buffer-name-simple' except the PROFILE name is added to it."
 225   (let ((simple-name (guix-buffer-name-simple
 226                       profile buffer-type entry-type))
 227         (profile-name (file-name-base (directory-file-name profile)))
 228         (re (rx string-start
 229                 (group (? "*"))
 230                 (group (*? any))
 231                 (group (? "*"))
 232                 string-end)))
 233     (or (string-match re simple-name)
 234         (error "Unexpected error in defining guix buffer name"))
 235     (let ((first*    (match-string 1 simple-name))
 236           (name-body (match-string 2 simple-name))
 237           (last*     (match-string 3 simple-name)))
 238       ;; Handle the case when buffer name is wrapped by '*'.
 239       (if (and (string= "*" first*)
 240                (string= "*" last*))
 241           (concat "*" name-body ": " profile-name "*")
 242         (concat simple-name ": " profile-name)))))
 243
 244 (defun guix-buffer-name (profile buffer-type entry-type search-type)
 245   "Return name of a buffer used for displaying information.
 246 See `guix-buffer-name-function' for details."
 247   (let ((fun (if (functionp guix-buffer-name-function)
 248                  guix-buffer-name-function
 249                #'guix-buffer-name-default)))
 250     (funcall fun profile buffer-type entry-type search-type)))
 251
 252 (defun guix-switch-to-buffer (buffer)
 253   "Switch to a 'list' or 'info' BUFFER."
 254   (pop-to-buffer buffer
 255                  '((display-buffer-reuse-window
 256                     display-buffer-same-window))))
 257
 258 (defun guix-buffer-p (&optional buffer modes)
 259   "Return non-nil if BUFFER mode is derived from any of the MODES.
 260 If BUFFER is nil, check current buffer.
 261 If MODES is nil, use `guix-list-mode' and `guix-info-mode'."
 262   (with-current-buffer (or buffer (current-buffer))
 263     (apply #'derived-mode-p
 264            (or modes
 265                '(guix-list-mode guix-info-mode)))))
 266
 267 (defun guix-buffers (&optional modes)
 268   "Return list of all buffers with major modes derived from MODES.
 269 If MODES is nil, return list of all Guix 'list' and 'info' buffers."
 270   (cl-remove-if-not (lambda (buf)
 271                       (guix-buffer-p buf modes))
 272                     (buffer-list)))
 273
 274 (defun guix-update-buffer (buffer)
 275   "Update information in a 'list' or 'info' BUFFER."
 276   (with-current-buffer buffer
 277     (guix-revert-buffer nil t)))
 278
 279 (defun guix-update-buffers-maybe-after-operation ()
 280   "Update buffers after Guix operation if needed.
 281 See `guix-update-after-operation' for details."
 282   (let ((to-update
 283          (and guix-operation-buffer
 284               (cl-case guix-update-after-operation
 285                 (current (and (buffer-live-p guix-operation-buffer)
 286                               (guix-buffer-p guix-operation-buffer)
 287                               (list guix-operation-buffer)))
 288                 (all     (guix-buffers))))))
 289     (setq guix-operation-buffer nil)
 290     (mapc #'guix-update-buffer to-update)))
 291
 292 (add-hook 'guix-after-repl-operation-hook
 293           'guix-update-buffers-maybe-after-operation)
 294
 295 \f
 296 ;;; Common definitions for buffer types
 297
 298 (defvar guix-root-map
 299   (let ((map (make-sparse-keymap)))
 300     (define-key map (kbd "l") 'guix-history-back)
 301     (define-key map (kbd "r") 'guix-history-forward)
 302     (define-key map (kbd "g") 'revert-buffer)
 303     (define-key map (kbd "R") 'guix-redisplay-buffer)
 304     (define-key map (kbd "M") 'guix-apply-manifest)
 305     (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)
 306     map)
 307   "Parent keymap for all guix modes.")
 308
 309 (defvar-local guix-profile nil
 310   "Profile used for the current buffer.")
 311 (put 'guix-profile 'permanent-local t)
 312
 313 (defvar-local guix-entries nil
 314   "List of the currently displayed entries.
 315 Each element of the list is alist with entry info of the
 316 following form:
 317
 318   ((PARAM . VAL) ...)
 319
 320 PARAM is a name of the entry parameter.
 321 VAL is a value of this parameter.")
 322 (put 'guix-entries 'permanent-local t)
 323
 324 (defvar-local guix-buffer-type nil
 325   "Type of the current buffer.")
 326 (put 'guix-buffer-type 'permanent-local t)
 327
 328 (defvar-local guix-entry-type nil
 329   "Type of the current entry.")
 330 (put 'guix-entry-type 'permanent-local t)
 331
 332 (defvar-local guix-search-type nil
 333   "Type of the current search.")
 334 (put 'guix-search-type 'permanent-local t)
 335
 336 (defvar-local guix-search-vals nil
 337   "Values of the current search.")
 338 (put 'guix-search-vals 'permanent-local t)
 339
 340 (defsubst guix-set-vars (profile entries buffer-type entry-type
 341                          search-type search-vals)
 342   "Set local variables for the current Guix buffer."
 343   (setq default-directory profile
 344         guix-profile      profile
 345         guix-entries      entries
 346         guix-buffer-type  buffer-type
 347         guix-entry-type   entry-type
 348         guix-search-type  search-type
 349         guix-search-vals  search-vals))
 350
 351 (defun guix-get-symbol (postfix buffer-type &optional entry-type)
 352   (intern (concat "guix-"
 353                   (when entry-type
 354                     (concat (symbol-name entry-type) "-"))
 355                   (symbol-name buffer-type) "-" postfix)))
 356
 357 (defmacro guix-define-buffer-type (buf-type entry-type &rest args)
 358   "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries.
 359
 360 In the text below TYPE means ENTRY-TYPE-BUF-TYPE.
 361
 362 This macro defines `guix-TYPE-mode', a custom group and several
 363 user variables.
 364
 365 The following stuff should be defined outside this macro:
 366
 367   - `guix-BUF-TYPE-mode' - parent mode for the defined mode.
 368
 369   - `guix-TYPE-mode-initialize' (optional) - function for
 370   additional mode settings; it is called without arguments.
 371
 372 Remaining argument (ARGS) should have a form [KEYWORD VALUE] ...  The
 373 following keywords are available:
 374
 375   - `:buffer-name' - default value for the defined
 376     `guix-TYPE-buffer-name' variable.
 377
 378   - `:required' - default value for the defined
 379     `guix-TYPE-required-params' variable.
 380
 381   - `:history-size' - default value for the defined
 382     `guix-TYPE-history-size' variable.
 383
 384   - `:revert' - default value for the defined
 385     `guix-TYPE-revert-no-confirm' variable."
 386   (let* ((entry-type-str (symbol-name entry-type))
 387          (buf-type-str   (symbol-name buf-type))
 388          (Entry-type-str (capitalize entry-type-str))
 389          (Buf-type-str   (capitalize buf-type-str))
 390          (entry-str      (concat entry-type-str " entries"))
 391          (buf-str        (concat buf-type-str " buffer"))
 392          (prefix         (concat "guix-" entry-type-str "-" buf-type-str))
 393          (group          (intern prefix))
 394          (mode-map-str   (concat prefix "-mode-map"))
 395          (mode-map       (intern mode-map-str))
 396          (parent-mode    (intern (concat "guix-" buf-type-str "-mode")))
 397          (mode           (intern (concat prefix "-mode")))
 398          (mode-init-fun  (intern (concat prefix "-mode-initialize")))
 399          (buf-name-var   (intern (concat prefix "-buffer-name")))
 400          (revert-var     (intern (concat prefix "-revert-no-confirm")))
 401          (history-var    (intern (concat prefix "-history-size")))
 402          (params-var     (intern (concat prefix "-required-params")))
 403          (buf-name-val   (format "*Guix %s %s*" Entry-type-str Buf-type-str))
 404          (revert-val     nil)
 405          (history-val    20)
 406          (params-val     '(id)))
 407
 408     ;; Process the keyword args.
 409     (while (keywordp (car args))
 410       (pcase (pop args)
 411         (`:required     (setq params-val (pop args)))
 412         (`:history-size (setq history-val (pop args)))
 413         (`:revert       (setq revert-val (pop args)))
 414         (`:buffer-name  (setq buf-name-val (pop args)))
 415         (_ (pop args))))
 416
 417     `(progn
 418        (defgroup ,group nil
 419          ,(concat Buf-type-str " buffer with " entry-str ".")
 420          :prefix ,(concat prefix "-")
 421          :group ',(intern (concat "guix-" buf-type-str)))
 422
 423        (defcustom ,buf-name-var ,buf-name-val
 424          ,(concat "Default name of the " buf-str " for displaying " entry-str ".")
 425          :type 'string
 426          :group ',group)
 427
 428        (defcustom ,history-var ,history-val
 429          ,(concat "Maximum number of items saved in the history of the " buf-str ".\n"
 430                   "If 0, the history is disabled.")
 431          :type 'integer
 432          :group ',group)
 433
 434        (defcustom ,revert-var ,revert-val
 435          ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".")
 436          :type 'boolean
 437          :group ',group)
 438
 439        (defvar ,params-var ',params-val
 440          ,(concat "List of required " entry-type-str " parameters.\n\n"
 441                   "Displayed parameters and parameters from this list are received\n"
 442                   "for each " entry-type-str ".\n\n"
 443                   "May be a special value `all', in which case all supported\n"
 444                   "parameters are received (this may be very slow for a big number\n"
 445                   "of entries).\n\n"
 446                   "Do not remove `id' from this list as it is required for\n"
 447                   "identifying an entry."))
 448
 449        (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
 450          ,(concat "Major mode for displaying information about " entry-str ".\n\n"
 451                   "\\{" mode-map-str "}")
 452          (setq-local revert-buffer-function 'guix-revert-buffer)
 453          (setq-local guix-history-size ,history-var)
 454          (and (fboundp ',mode-init-fun) (,mode-init-fun))))))
 455
 456 (put 'guix-define-buffer-type 'lisp-indent-function 'defun)
 457
 458 \f
 459 ;;; Getting and displaying info about packages and generations
 460
 461 (defcustom guix-package-list-type 'output
 462   "Define how to display packages in a list buffer.
 463 May be a symbol `package' or `output' (if `output', display each
 464 output on a separate line; if `package', display each package on
 465 a separate line)."
 466   :type '(choice (const :tag "List of packages" package)
 467                  (const :tag "List of outputs" output))
 468   :group 'guix)
 469
 470 (defcustom guix-package-info-type 'package
 471   "Define how to display packages in an info buffer.
 472 May be a symbol `package' or `output' (if `output', display each
 473 output separately; if `package', display outputs inside a package
 474 information)."
 475   :type '(choice (const :tag "Display packages" package)
 476                  (const :tag "Display outputs" output))
 477   :group 'guix)
 478
 479 (defun guix-get-entries (profile entry-type search-type search-vals
 480                          &optional params)
 481   "Search for entries of ENTRY-TYPE.
 482
 483 Call an appropriate scheme function and return a list of the
 484 form of `guix-entries'.
 485
 486 ENTRY-TYPE should be one of the following symbols: `package',
 487 `output' or `generation'.
 488
 489 SEARCH-TYPE may be one of the following symbols:
 490
 491 - If ENTRY-TYPE is `package' or `output': `id', `name', `regexp',
 492   `all-available', `newest-available', `installed', `obsolete',
 493   `generation'.
 494
 495 - If ENTRY-TYPE is `generation': `id', `last', `all', `time'.
 496
 497 PARAMS is a list of parameters for receiving.  If nil, get
 498 information with all available parameters."
 499   (guix-eval-read (guix-make-guile-expression
 500                    'entries
 501                    profile params entry-type search-type search-vals)))
 502
 503 (defun guix-get-show-entries (profile buffer-type entry-type search-type
 504                               &rest search-vals)
 505   "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer.
 506 See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS."
 507   (let ((entries (guix-get-entries profile entry-type search-type search-vals
 508                                    (guix-get-params-for-receiving
 509                                     buffer-type entry-type))))
 510     (guix-set-buffer profile entries buffer-type entry-type
 511                      search-type search-vals)))
 512
 513 (defun guix-set-buffer (profile entries buffer-type entry-type search-type
 514                         search-vals &optional history-replace no-display)
 515   "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES.
 516
 517 Insert ENTRIES in buffer, set variables and make history item.
 518 ENTRIES should have a form of `guix-entries'.
 519
 520 See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS.
 521
 522 If HISTORY-REPLACE is non-nil, replace current history item,
 523 otherwise add the new one.
 524
 525 If NO-DISPLAY is non-nil, do not switch to the buffer."
 526   (when entries
 527     (let ((buf (if (and (eq major-mode
 528                             (guix-get-symbol "mode" buffer-type entry-type))
 529                         (equal guix-profile profile))
 530                    (current-buffer)
 531                  (get-buffer-create
 532                   (guix-buffer-name profile buffer-type
 533                                     entry-type search-type)))))
 534       (with-current-buffer buf
 535         (guix-show-entries entries buffer-type entry-type)
 536         (guix-set-vars profile entries buffer-type entry-type
 537                        search-type search-vals)
 538         (funcall (if history-replace
 539                      #'guix-history-replace
 540                    #'guix-history-add)
 541                  (guix-make-history-item)))
 542       (or no-display
 543           (guix-switch-to-buffer buf))))
 544   (guix-result-message profile entries entry-type
 545                        search-type search-vals))
 546
 547 (defun guix-show-entries (entries buffer-type entry-type)
 548   "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
 549   (let ((inhibit-read-only t))
 550     (erase-buffer)
 551     (funcall (symbol-function (guix-get-symbol
 552                                "mode" buffer-type entry-type)))
 553     (funcall (guix-get-symbol "insert-entries" buffer-type)
 554              entries entry-type)
 555     (goto-char (point-min))))
 556
 557 (defun guix-history-call (profile entries buffer-type entry-type
 558                           search-type search-vals)
 559   "Function called for moving by history."
 560   (guix-show-entries entries buffer-type entry-type)
 561   (guix-set-vars profile entries buffer-type entry-type
 562                  search-type search-vals)
 563   (guix-result-message profile entries entry-type
 564                        search-type search-vals))
 565
 566 (defun guix-make-history-item ()
 567   "Make and return a history item for the current buffer."
 568   (list #'guix-history-call
 569         guix-profile guix-entries guix-buffer-type guix-entry-type
 570         guix-search-type guix-search-vals))
 571
 572 (defun guix-get-params-for-receiving (buffer-type entry-type)
 573   "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE."
 574   (let* ((required-var (guix-get-symbol "required-params"
 575                                         buffer-type entry-type))
 576          (required (symbol-value required-var)))
 577     (unless (equal required 'all)
 578       (cl-union required
 579                 (funcall (guix-get-symbol "get-displayed-params"
 580                                           buffer-type)
 581                          entry-type)))))
 582
 583 (defun guix-revert-buffer (_ignore-auto noconfirm)
 584   "Update information in the current buffer.
 585 The function is suitable for `revert-buffer-function'.
 586 See `revert-buffer' for the meaning of NOCONFIRM."
 587   (when (or noconfirm
 588             (symbol-value
 589              (guix-get-symbol "revert-no-confirm"
 590                               guix-buffer-type guix-entry-type))
 591             (y-or-n-p "Update current information? "))
 592     (let* ((search-type guix-search-type)
 593            (search-vals guix-search-vals)
 594            (params (guix-get-params-for-receiving guix-buffer-type
 595                                                   guix-entry-type))
 596            (entries (guix-get-entries
 597                      guix-profile guix-entry-type
 598                      guix-search-type guix-search-vals params))
 599            ;; If a REPL was restarted, package/output IDs are not actual
 600            ;; anymore, because 'object-address'-es died with the REPL, so if a
 601            ;; search by ID didn't give results, search again by name.
 602            (entries (if (and (null entries)
 603                              (eq guix-search-type 'id)
 604                              (or (eq guix-entry-type 'package)
 605                                  (eq guix-entry-type 'output)))
 606                         (progn
 607                           (setq search-type 'name
 608                                 search-vals (guix-entries-to-specifications
 609                                              guix-entries))
 610                           (guix-get-entries
 611                            guix-profile guix-entry-type
 612                            search-type search-vals params))
 613                       entries)))
 614       (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type
 615                        search-type search-vals t t))))
 616
 617 (cl-defun guix-redisplay-buffer (&key buffer profile entries buffer-type
 618                                       entry-type search-type search-vals)
 619   "Redisplay a Guix BUFFER.
 620 Restore the point and window positions after redisplaying if possible.
 621
 622 This function will not update the information, use
 623 \"\\[revert-buffer]\" if you want the full update.
 624
 625 If BUFFER is nil, use the current buffer.  For the meaning of the
 626 rest arguments, see `guix-set-buffer'."
 627   (interactive)
 628   (or buffer (setq buffer (current-buffer)))
 629   (with-current-buffer buffer
 630     (or (derived-mode-p 'guix-info-mode 'guix-list-mode)
 631         (error "%S is not a Guix buffer" buffer))
 632     (let* ((point (point))
 633            (was-at-button (button-at point))
 634            ;; For simplicity, ignore an unlikely case when multiple
 635            ;; windows display the same BUFFER.
 636            (window (car (get-buffer-window-list buffer nil t)))
 637            (window-start (and window (window-start window))))
 638       (guix-set-buffer (or profile     guix-profile)
 639                        (or entries     guix-entries)
 640                        (or buffer-type guix-buffer-type)
 641                        (or entry-type  guix-entry-type)
 642                        (or search-type guix-search-type)
 643                        (or search-vals guix-search-vals)
 644                        t t)
 645       (goto-char point)
 646       (and was-at-button
 647            (not (button-at (point)))
 648            (forward-button 1))
 649       (when window
 650         (set-window-point window (point))
 651         (set-window-start window window-start)))))
 652
 653 \f
 654 ;;; Generations
 655
 656 (defcustom guix-generation-packages-buffer-name-function
 657   #'guix-generation-packages-buffer-name-default
 658   "Function used to define name of a buffer with generation packages.
 659 This function is called with 2 arguments: PROFILE (string) and
 660 GENERATION (number)."
 661   :type '(choice (function-item guix-generation-packages-buffer-name-default)
 662                  (function-item guix-generation-packages-buffer-name-long)
 663                  (function :tag "Other function"))
 664   :group 'guix)
 665
 666 (defcustom guix-generation-packages-update-buffer t
 667   "If non-nil, always update list of packages during comparing generations.
 668 If nil, generation packages are received only once.  So when you
 669 compare generation 1 and generation 2, the packages for both
 670 generations will be received.  Then if you compare generation 1
 671 and generation 3, only the packages for generation 3 will be
 672 received.  Thus if you use comparing of different generations a
 673 lot, you may set this variable to nil to improve the
 674 performance."
 675   :type 'boolean
 676   :group 'guix)
 677
 678 (defvar guix-output-name-width 30
 679   "Width of an output name \"column\".
 680 This variable is used in auxiliary buffers for comparing generations.")
 681
 682 (defun guix-generation-file (profile generation)
 683   "Return the file name of a PROFILE's GENERATION."
 684   (format "%s-%s-link" profile generation))
 685
 686 (defun guix-manifest-file (profile &optional generation)
 687   "Return the file name of a PROFILE's manifest.
 688 If GENERATION number is specified, return manifest file name for
 689 this generation."
 690   (expand-file-name "manifest"
 691                     (if generation
 692                         (guix-generation-file profile generation)
 693                       profile)))
 694
 695 (defun guix-generation-packages (profile generation)
 696   "Return a list of sorted packages installed in PROFILE's GENERATION.
 697 Each element of the list is a list of the package specification and its path."
 698   (let ((names+paths (guix-eval-read
 699                       (guix-make-guile-expression
 700                        'generation-package-specifications+paths
 701                        profile generation))))
 702     (sort names+paths
 703           (lambda (a b)
 704             (string< (car a) (car b))))))
 705
 706 (defun guix-generation-packages-buffer-name-default (profile generation)
 707   "Return name of a buffer for displaying GENERATION's package outputs.
 708 Use base name of PROFILE path."
 709   (let ((profile-name (file-name-base (directory-file-name profile))))
 710     (format "*Guix %s: generation %s*"
 711             profile-name generation)))
 712
 713 (defun guix-generation-packages-buffer-name-long (profile generation)
 714   "Return name of a buffer for displaying GENERATION's package outputs.
 715 Use the full PROFILE path."
 716   (format "*Guix generation %s (%s)*"
 717           generation profile))
 718
 719 (defun guix-generation-packages-buffer-name (profile generation)
 720   "Return name of a buffer for displaying GENERATION's package outputs."
 721   (let ((fun (if (functionp guix-generation-packages-buffer-name-function)
 722                  guix-generation-packages-buffer-name-function
 723                #'guix-generation-packages-buffer-name-default)))
 724     (funcall fun profile generation)))
 725
 726 (defun guix-generation-insert-package (name path)
 727   "Insert package output NAME and PATH at point."
 728   (insert name)
 729   (indent-to guix-output-name-width 2)
 730   (insert path "\n"))
 731
 732 (defun guix-generation-insert-packages (buffer profile generation)
 733   "Insert package outputs installed in PROFILE's GENERATION in BUFFER."
 734   (with-current-buffer buffer
 735     (setq buffer-read-only nil
 736           indent-tabs-mode nil)
 737     (erase-buffer)
 738     (mapc (lambda (name+path)
 739             (guix-generation-insert-package
 740              (car name+path) (cadr name+path)))
 741           (guix-generation-packages profile generation))))
 742
 743 (defun guix-generation-packages-buffer (profile generation)
 744   "Return buffer with package outputs installed in PROFILE's GENERATION.
 745 Create the buffer if needed."
 746   (let ((buf-name (guix-generation-packages-buffer-name
 747                    profile generation)))
 748     (or (and (null guix-generation-packages-update-buffer)
 749              (get-buffer buf-name))
 750         (let ((buf (get-buffer-create buf-name)))
 751           (guix-generation-insert-packages buf profile generation)
 752           buf))))
 753
 754 (defun guix-profile-generation-manifest-file (generation)
 755   "Return the file name of a GENERATION's manifest.
 756 GENERATION is a generation number of `guix-profile' profile."
 757   (guix-manifest-file guix-profile generation))
 758
 759 (defun guix-profile-generation-packages-buffer (generation)
 760   "Insert GENERATION's package outputs in a buffer and return it.
 761 GENERATION is a generation number of `guix-profile' profile."
 762   (guix-generation-packages-buffer guix-profile generation))
 763
 764 \f
 765 ;;; Actions on packages and generations
 766
 767 (defface guix-operation-option-key
 768   '((t :inherit font-lock-warning-face))
 769   "Face used for the keys of operation options."
 770   :group 'guix)
 771
 772 (defcustom guix-operation-confirm t
 773   "If nil, do not prompt to confirm an operation."
 774   :type 'boolean
 775   :group 'guix)
 776
 777 (defcustom guix-use-substitutes t
 778   "If non-nil, use substitutes for the Guix packages."
 779   :type 'boolean
 780   :group 'guix)
 781
 782 (defvar guix-dry-run nil
 783   "If non-nil, do not perform the real actions, just simulate.")
 784
 785 (defvar guix-temp-buffer-name " *Guix temp*"
 786   "Name of a buffer used for displaying info before executing operation.")
 787
 788 (defvar guix-operation-option-true-string "yes"
 789   "String displayed in the mode-line when operation option is t.")
 790
 791 (defvar guix-operation-option-false-string "no "
 792   "String displayed in the mode-line when operation option is nil.")
 793
 794 (defvar guix-operation-option-separator "  |  "
 795   "String used in the mode-line to separate operation options.")
 796
 797 (defvar guix-operation-options
 798   '((?s "substitutes" guix-use-substitutes)
 799     (?d "dry-run"     guix-dry-run))
 800   "List of available operation options.
 801 Each element of the list has a form:
 802
 803   (KEY NAME VARIABLE)
 804
 805 KEY is a character that may be pressed during confirmation to
 806 toggle the option.
 807 NAME is a string displayed in the mode-line.
 808 VARIABLE is a name of an option variable.")
 809
 810 (defun guix-operation-option-by-key (key)
 811   "Return operation option by KEY (character)."
 812   (assq key guix-operation-options))
 813
 814 (defun guix-operation-option-key (option)
 815   "Return key (character) of the operation OPTION."
 816   (car option))
 817
 818 (defun guix-operation-option-name (option)
 819   "Return name of the operation OPTION."
 820   (nth 1 option))
 821
 822 (defun guix-operation-option-variable (option)
 823   "Return name of the variable of the operation OPTION."
 824   (nth 2 option))
 825
 826 (defun guix-operation-option-value (option)
 827   "Return boolean value of the operation OPTION."
 828   (symbol-value (guix-operation-option-variable option)))
 829
 830 (defun guix-operation-option-string-value (option)
 831   "Convert boolean value of the operation OPTION to string and return it."
 832   (if (guix-operation-option-value option)
 833       guix-operation-option-true-string
 834     guix-operation-option-false-string))
 835
 836 (defun guix-process-package-actions (profile actions
 837                                      &optional operation-buffer)
 838   "Process package ACTIONS on PROFILE.
 839 Each action is a list of the form:
 840
 841   (ACTION-TYPE PACKAGE-SPEC ...)
 842
 843 ACTION-TYPE is one of the following symbols: `install',
 844 `upgrade', `remove'/`delete'.
 845 PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
 846   (let (install upgrade remove)
 847     (mapc (lambda (action)
 848             (let ((action-type (car action))
 849                   (specs (cdr action)))
 850               (cl-case action-type
 851                 (install (setq install (append install specs)))
 852                 (upgrade (setq upgrade (append upgrade specs)))
 853                 ((remove delete) (setq remove (append remove specs))))))
 854           actions)
 855     (when (guix-continue-package-operation-p
 856            profile
 857            :install install :upgrade upgrade :remove remove)
 858       (guix-eval-in-repl
 859        (guix-make-guile-expression
 860         'process-package-actions profile
 861         :install install :upgrade upgrade :remove remove
 862         :use-substitutes? (or guix-use-substitutes 'f)
 863         :dry-run? (or guix-dry-run 'f))
 864        (and (not guix-dry-run) operation-buffer)))))
 865
 866 (cl-defun guix-continue-package-operation-p (profile
 867                                              &key install upgrade remove)
 868   "Return non-nil if a package operation should be continued.
 869 Ask a user if needed (see `guix-operation-confirm').
 870 INSTALL, UPGRADE, REMOVE are 'package action specifications'.
 871 See `guix-process-package-actions' for details."
 872   (or (null guix-operation-confirm)
 873       (let* ((entries (guix-get-entries
 874                        profile 'package 'id
 875                        (append (mapcar #'car install)
 876                                (mapcar #'car upgrade)
 877                                (mapcar #'car remove))
 878                        '(id name version location)))
 879              (install-strings (guix-get-package-strings install entries))
 880              (upgrade-strings (guix-get-package-strings upgrade entries))
 881              (remove-strings  (guix-get-package-strings remove entries)))
 882         (if (or install-strings upgrade-strings remove-strings)
 883             (let ((buf (get-buffer-create guix-temp-buffer-name)))
 884               (with-current-buffer buf
 885                 (setq-local cursor-type nil)
 886                 (setq buffer-read-only nil)
 887                 (erase-buffer)
 888                 (insert "Profile: " profile "\n\n")
 889                 (guix-insert-package-strings install-strings "install")
 890                 (guix-insert-package-strings upgrade-strings "upgrade")
 891                 (guix-insert-package-strings remove-strings "remove")
 892                 (let ((win (temp-buffer-window-show
 893                             buf
 894                             '((display-buffer-reuse-window
 895                                display-buffer-at-bottom)
 896                               (window-height . fit-window-to-buffer)))))
 897                   (prog1 (guix-operation-prompt)
 898                     (quit-window nil win)))))
 899           (message "Nothing to be done.  If the REPL was restarted, information is not up-to-date.")
 900           nil))))
 901
 902 (defun guix-get-package-strings (specs entries)
 903   "Return short package descriptions for performing package actions.
 904 See `guix-process-package-actions' for the meaning of SPECS.
 905 ENTRIES is a list of package entries to get info about packages."
 906   (delq nil
 907         (mapcar
 908          (lambda (spec)
 909            (let* ((id (car spec))
 910                   (outputs (cdr spec))
 911                   (entry (guix-get-entry-by-id id entries)))
 912              (when entry
 913                (let ((location (guix-get-key-val entry 'location)))
 914                  (concat (guix-get-full-name entry)
 915                          (when outputs
 916                            (concat ":"
 917                                    (mapconcat #'identity outputs ",")))
 918                          (when location
 919                            (concat "\t(" location ")")))))))
 920          specs)))
 921
 922 (defun guix-insert-package-strings (strings action)
 923   "Insert information STRINGS at point for performing package ACTION."
 924   (when strings
 925     (insert "Package(s) to " (propertize action 'face 'bold) ":\n")
 926     (mapc (lambda (str)
 927             (insert "  " str "\n"))
 928           strings)
 929     (insert "\n")))
 930
 931 (defun guix-operation-prompt (&optional prompt)
 932   "Prompt a user for continuing the current operation.
 933 Return non-nil, if the operation should be continued; nil otherwise.
 934 Ask a user with PROMPT for continuing an operation."
 935   (let* ((option-keys (mapcar #'guix-operation-option-key
 936                               guix-operation-options))
 937          (keys (append '(?y ?n) option-keys))
 938          (prompt (concat (propertize (or prompt "Continue operation?")
 939                                      'face 'minibuffer-prompt)
 940                          " ("
 941                          (mapconcat
 942                           (lambda (key)
 943                             (propertize (string key)
 944                                         'face 'guix-operation-option-key))
 945                           keys
 946                           ", ")
 947                          ") ")))
 948     (let ((mode-line mode-line-format))
 949       (prog1 (guix-operation-prompt-1 prompt keys)
 950         (setq mode-line-format mode-line)
 951         ;; Clear the minibuffer after prompting.
 952         (message "")))))
 953
 954 (defun guix-operation-prompt-1 (prompt keys)
 955   "This function is internal for `guix-operation-prompt'."
 956   (guix-operation-set-mode-line)
 957   (let ((key (read-char-choice prompt (cons ?\C-g keys) t)))
 958     (cl-case key
 959       (?y t)
 960       ((?n ?\C-g) nil)
 961       (t (let* ((option (guix-operation-option-by-key key))
 962                 (var (guix-operation-option-variable option)))
 963            (set var (not (symbol-value var)))
 964            (guix-operation-prompt-1 prompt keys))))))
 965
 966 (defun guix-operation-set-mode-line ()
 967   "Display operation options in the mode-line of the current buffer."
 968   (setq mode-line-format
 969         (concat (propertize " Options:   "
 970                             'face 'mode-line-buffer-id)
 971                 (mapconcat
 972                  (lambda (option)
 973                    (let ((key  (guix-operation-option-key option))
 974                          (name (guix-operation-option-name option))
 975                          (val  (guix-operation-option-string-value option)))
 976                      (concat name
 977                              " ("
 978                              (propertize (string key)
 979                                          'face 'guix-operation-option-key)
 980                              "): " val)))
 981                  guix-operation-options
 982                  guix-operation-option-separator)))
 983   (force-mode-line-update))
 984
 985 (defun guix-delete-generations (profile generations
 986                                 &optional operation-buffer)
 987   "Delete GENERATIONS from PROFILE.
 988 Each element from GENERATIONS is a generation number."
 989   (when (or (not guix-operation-confirm)
 990             (y-or-n-p
 991              (let ((count (length generations)))
 992                (if (> count 1)
 993                    (format "Delete %d generations from profile '%s'? "
 994                            count profile)
 995                  (format "Delete generation %d from profile '%s'? "
 996                          (car generations) profile)))))
 997     (guix-eval-in-repl
 998      (guix-make-guile-expression
 999       'delete-generations* profile generations)
1000      operation-buffer)))
1001
1002 (defun guix-switch-to-generation (profile generation
1003                                   &optional operation-buffer)
1004   "Switch PROFILE to GENERATION."
1005   (when (or (not guix-operation-confirm)
1006             (y-or-n-p (format "Switch profile '%s' to generation %d? "
1007                               profile generation)))
1008     (guix-eval-in-repl
1009      (guix-make-guile-expression
1010       'switch-to-generation profile generation)
1011      operation-buffer)))
1012
1013 (defun guix-package-source-path (package-id)
1014   "Return a store file path to a source of a package PACKAGE-ID."
1015   (message "Calculating the source derivation ...")
1016   (guix-eval-read
1017    (guix-make-guile-expression
1018     'package-source-path package-id)))
1019
1020 (defvar guix-after-source-download-hook nil
1021   "Hook run after successful performing a 'source-download' operation.")
1022
1023 (defun guix-package-source-build-derivation (package-id &optional prompt)
1024   "Build source derivation of a package PACKAGE-ID.
1025 Ask a user with PROMPT for continuing an operation."
1026   (when (or (not guix-operation-confirm)
1027             (guix-operation-prompt (or prompt
1028                                        "Build the source derivation?")))
1029     (guix-eval-in-repl
1030      (guix-make-guile-expression
1031       'package-source-build-derivation
1032       package-id
1033       :use-substitutes? (or guix-use-substitutes 'f)
1034       :dry-run? (or guix-dry-run 'f))
1035      nil 'source-download)))
1036
1037 ;;;###autoload
1038 (defun guix-apply-manifest (profile file &optional operation-buffer)
1039   "Apply manifest from FILE to PROFILE.
1040 This function has the same meaning as 'guix package --manifest' command.
1041 See Info node `(guix) Invoking guix package' for details.
1042
1043 Interactively, use the current profile and prompt for manifest
1044 FILE.  With a prefix argument, also prompt for PROFILE."
1045   (interactive
1046    (let* ((default-profile (or guix-profile guix-current-profile))
1047           (profile (if current-prefix-arg
1048                        (guix-profile-prompt)
1049                      default-profile))
1050           (file (read-file-name "File with manifest: "))
1051           (buffer (and guix-profile (current-buffer))))
1052      (list profile file buffer)))
1053   (when (or (not guix-operation-confirm)
1054             (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? "
1055                               file profile)))
1056     (guix-eval-in-repl
1057      (guix-make-guile-expression
1058       'guix-package
1059       (concat "--profile=" profile)
1060       (concat "--manifest=" file))
1061      operation-buffer)))
1062
1063 \f
1064 ;;; Pull
1065
1066 (defcustom guix-update-after-pull t
1067   "If non-nil, update Guix buffers after performing \\[guix-pull]."
1068   :type 'boolean
1069   :group 'guix)
1070
1071 (defvar guix-after-pull-hook
1072   '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull)
1073   "Hook run after successful performing `guix-pull' operation.")
1074
1075 (defun guix-restart-repl-after-pull ()
1076   "Restart Guix REPL after `guix-pull' operation."
1077   (guix-repl-exit)
1078   (guix-start-process-maybe
1079    "Restarting Guix REPL after pull operation ..."))
1080
1081 (defun guix-update-buffers-maybe-after-pull ()
1082   "Update buffers depending on `guix-update-after-pull'."
1083   (when guix-update-after-pull
1084     (mapc #'guix-update-buffer
1085           ;; No need to update "generation" buffers.
1086           (guix-buffers '(guix-package-list-mode
1087                           guix-package-info-mode
1088                           guix-output-list-mode
1089                           guix-output-info-mode)))
1090     (message "Guix buffers have been updated.")))
1091
1092 ;;;###autoload
1093 (defun guix-pull (&optional verbose)
1094   "Run Guix pull operation.
1095 If VERBOSE is non-nil (with prefix argument), produce verbose output."
1096   (interactive)
1097   (let ((args (and verbose '("--verbose"))))
1098     (guix-eval-in-repl
1099      (apply #'guix-make-guile-expression 'guix-pull args)
1100      nil 'pull)))
1101
1102 (provide 'guix-base)
1103
1104 ;;; guix-base.el ends here