emacs/guix-ui-package.el

   1 ;;; guix-ui-package.el --- Interface for displaying packages  -*- lexical-binding: t -*-
   2
   3 ;; Copyright © 2014, 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 an interface for displaying packages and outputs
  23 ;; in 'list' and 'info' buffers, and commands for working with them.
  24
  25 ;;; Code:
  26
  27 (require 'cl-lib)
  28 (require 'guix-buffer)
  29 (require 'guix-list)
  30 (require 'guix-info)
  31 (require 'guix-ui)
  32 (require 'guix-base)
  33 (require 'guix-backend)
  34 (require 'guix-guile)
  35 (require 'guix-entry)
  36 (require 'guix-utils)
  37 (require 'guix-hydra-build)
  38
  39 (guix-ui-define-entry-type package)
  40 (guix-ui-define-entry-type output)
  41
  42 (defcustom guix-package-list-type 'output
  43   "Define how to display packages in 'list' buffer.
  44 Should be a symbol `package' or `output' (if `output', display each
  45 output on a separate line; if `package', display each package on
  46 a separate line)."
  47   :type '(choice (const :tag "List of packages" package)
  48                  (const :tag "List of outputs" output))
  49   :group 'guix-package)
  50
  51 (defcustom guix-package-info-type 'package
  52   "Define how to display packages in 'info' buffer.
  53 Should be a symbol `package' or `output' (if `output', display
  54 each output separately; if `package', display outputs inside
  55 package data)."
  56   :type '(choice (const :tag "Display packages" package)
  57                  (const :tag "Display outputs" output))
  58   :group 'guix-package)
  59
  60 (defun guix-package-get-display (profile search-type &rest search-values)
  61   "Search for packages/outputs and show results.
  62
  63 If PROFILE is nil, use `guix-current-profile'.
  64
  65 See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
  66 SEARCH-VALUES.
  67
  68 Results are displayed in the list buffer, unless a single package
  69 is found and `guix-package-list-single' is nil."
  70   (let* ((args    (cl-list* (or profile guix-current-profile)
  71                             search-type search-values))
  72          (entries (guix-buffer-get-entries
  73                    'list guix-package-list-type args)))
  74     (if (or guix-package-list-single
  75             (null entries)
  76             (cdr entries))
  77         (guix-buffer-display-entries
  78          entries 'list guix-package-list-type args 'add)
  79       (guix-buffer-get-display-entries
  80        'info guix-package-info-type args 'add))))
  81
  82 (defun guix-package-entry->name-specification (entry &optional output)
  83   "Return name specification of the package ENTRY and OUTPUT."
  84   (guix-package-name-specification
  85    (guix-entry-value entry 'name)
  86    (guix-entry-value entry 'version)
  87    (or output (guix-entry-value entry 'output))))
  88
  89 (defun guix-package-entries->name-specifications (entries)
  90   "Return name specifications by the package or output ENTRIES."
  91   (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification
  92                                 entries)
  93                         :test #'string=))
  94
  95 (defun guix-package-installed-outputs (entry)
  96   "Return a list of installed outputs for the package ENTRY."
  97   (mapcar (lambda (installed-entry)
  98             (guix-entry-value installed-entry 'output))
  99           (guix-entry-value entry 'installed)))
 100
 101 (defun guix-package-id-and-output-by-output-id (output-id)
 102   "Return a list (PACKAGE-ID OUTPUT) by OUTPUT-ID."
 103   (cl-multiple-value-bind (package-id-str output)
 104       (split-string output-id ":")
 105     (let ((package-id (string-to-number package-id-str)))
 106       (list (if (= 0 package-id) package-id-str package-id)
 107             output))))
 108
 109 \f
 110 ;;; Processing package actions
 111
 112 (defun guix-process-package-actions (profile actions
 113                                      &optional operation-buffer)
 114   "Process package ACTIONS on PROFILE.
 115 Each action is a list of the form:
 116
 117   (ACTION-TYPE PACKAGE-SPEC ...)
 118
 119 ACTION-TYPE is one of the following symbols: `install',
 120 `upgrade', `remove'/`delete'.
 121 PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
 122   (let (install upgrade remove)
 123     (mapc (lambda (action)
 124             (let ((action-type (car action))
 125                   (specs (cdr action)))
 126               (cl-case action-type
 127                 (install (setq install (append install specs)))
 128                 (upgrade (setq upgrade (append upgrade specs)))
 129                 ((remove delete) (setq remove (append remove specs))))))
 130           actions)
 131     (when (guix-continue-package-operation-p
 132            profile
 133            :install install :upgrade upgrade :remove remove)
 134       (guix-eval-in-repl
 135        (guix-make-guile-expression
 136         'process-package-actions profile
 137         :install install :upgrade upgrade :remove remove
 138         :use-substitutes? (or guix-use-substitutes 'f)
 139         :dry-run? (or guix-dry-run 'f))
 140        (and (not guix-dry-run) operation-buffer)))))
 141
 142 (cl-defun guix-continue-package-operation-p (profile
 143                                              &key install upgrade remove)
 144   "Return non-nil if a package operation should be continued.
 145 Ask a user if needed (see `guix-operation-confirm').
 146 INSTALL, UPGRADE, REMOVE are 'package action specifications'.
 147 See `guix-process-package-actions' for details."
 148   (or (null guix-operation-confirm)
 149       (let* ((entries (guix-ui-get-entries
 150                        profile 'package 'id
 151                        (append (mapcar #'car install)
 152                                (mapcar #'car upgrade)
 153                                (mapcar #'car remove))
 154                        '(id name version location)))
 155              (install-strings (guix-get-package-strings install entries))
 156              (upgrade-strings (guix-get-package-strings upgrade entries))
 157              (remove-strings  (guix-get-package-strings remove entries)))
 158         (if (or install-strings upgrade-strings remove-strings)
 159             (let ((buf (get-buffer-create guix-temp-buffer-name)))
 160               (with-current-buffer buf
 161                 (setq-local cursor-type nil)
 162                 (setq buffer-read-only nil)
 163                 (erase-buffer)
 164                 (insert "Profile: " profile "\n\n")
 165                 (guix-insert-package-strings install-strings "install")
 166                 (guix-insert-package-strings upgrade-strings "upgrade")
 167                 (guix-insert-package-strings remove-strings "remove")
 168                 (let ((win (temp-buffer-window-show
 169                             buf
 170                             '((display-buffer-reuse-window
 171                                display-buffer-at-bottom)
 172                               (window-height . fit-window-to-buffer)))))
 173                   (prog1 (guix-operation-prompt)
 174                     (quit-window nil win)))))
 175           (message "Nothing to be done.
 176 If Guix REPL was restarted, the data is not up-to-date.")
 177           nil))))
 178
 179 (defun guix-get-package-strings (specs entries)
 180   "Return short package descriptions for performing package actions.
 181 See `guix-process-package-actions' for the meaning of SPECS.
 182 ENTRIES is a list of package entries to get info about packages."
 183   (delq nil
 184         (mapcar
 185          (lambda (spec)
 186            (let* ((id (car spec))
 187                   (outputs (cdr spec))
 188                   (entry (guix-entry-by-id id entries)))
 189              (when entry
 190                (let ((location (guix-entry-value entry 'location)))
 191                  (concat (guix-package-entry->name-specification entry)
 192                          (when outputs
 193                            (concat ":"
 194                                    (guix-concat-strings outputs ",")))
 195                          (when location
 196                            (concat "\t(" location ")")))))))
 197          specs)))
 198
 199 (defun guix-insert-package-strings (strings action)
 200   "Insert information STRINGS at point for performing package ACTION."
 201   (when strings
 202     (insert "Package(s) to " (propertize action 'face 'bold) ":\n")
 203     (mapc (lambda (str)
 204             (insert "  " str "\n"))
 205           strings)
 206     (insert "\n")))
 207
 208 \f
 209 ;;; Package 'info'
 210
 211 (guix-ui-info-define-interface package
 212   :buffer-name "*Guix Package Info*"
 213   :format '(guix-package-info-insert-heading
 214             ignore
 215             (synopsis ignore (simple guix-package-info-synopsis))
 216             ignore
 217             (description ignore (simple guix-package-info-description))
 218             ignore
 219             (outputs simple guix-package-info-insert-outputs)
 220             (source simple guix-package-info-insert-source)
 221             (location format (format guix-package-location))
 222             (home-url format (format guix-url))
 223             (license format (format guix-package-info-license))
 224             (inputs format (format guix-package-input))
 225             (native-inputs format (format guix-package-native-input))
 226             (propagated-inputs format
 227                                (format guix-package-propagated-input)))
 228   :titles '((home-url . "Home page"))
 229   :required '(id name version installed non-unique))
 230
 231 (guix-info-define-interface installed-output
 232   :format '((path simple (indent guix-file))
 233             (dependencies simple (indent guix-file)))
 234   :titles '((path . "Store directory"))
 235   :reduced? t)
 236
 237 (defface guix-package-info-heading
 238   '((t :inherit guix-info-heading))
 239   "Face for package name and version headings."
 240   :group 'guix-package-info-faces)
 241
 242 (defface guix-package-info-name
 243   '((t :inherit font-lock-keyword-face))
 244   "Face used for a name of a package."
 245   :group 'guix-package-info-faces)
 246
 247 (defface guix-package-info-name-button
 248   '((t :inherit button))
 249   "Face used for a full name that can be used to describe a package."
 250   :group 'guix-package-info-faces)
 251
 252 (defface guix-package-info-version
 253   '((t :inherit font-lock-builtin-face))
 254   "Face used for a version of a package."
 255   :group 'guix-package-info-faces)
 256
 257 (defface guix-package-info-synopsis
 258   '((((type tty pc) (class color)) :weight bold)
 259     (t :height 1.1 :weight bold :inherit variable-pitch))
 260   "Face used for a synopsis of a package."
 261   :group 'guix-package-info-faces)
 262
 263 (defface guix-package-info-description
 264   '((t))
 265   "Face used for a description of a package."
 266   :group 'guix-package-info-faces)
 267
 268 (defface guix-package-info-license
 269   '((t :inherit font-lock-string-face))
 270   "Face used for a license of a package."
 271   :group 'guix-package-info-faces)
 272
 273 (defface guix-package-info-location
 274   '((t :inherit link))
 275   "Face used for a location of a package."
 276   :group 'guix-package-info-faces)
 277
 278 (defface guix-package-info-source
 279   '((t :inherit link :underline nil))
 280   "Face used for a source URL of a package."
 281   :group 'guix-package-info-faces)
 282
 283 (defface guix-package-info-installed-outputs
 284   '((default :weight bold)
 285     (((class color) (min-colors 88) (background light))
 286      :foreground "ForestGreen")
 287     (((class color) (min-colors 88) (background dark))
 288      :foreground "PaleGreen")
 289     (((class color) (min-colors 8))
 290      :foreground "green")
 291     (t :underline t))
 292   "Face used for installed outputs of a package."
 293   :group 'guix-package-info-faces)
 294
 295 (defface guix-package-info-uninstalled-outputs
 296   '((t :weight bold))
 297   "Face used for uninstalled outputs of a package."
 298   :group 'guix-package-info-faces)
 299
 300 (defface guix-package-info-obsolete
 301   '((t :inherit error))
 302   "Face used if a package is obsolete."
 303   :group 'guix-package-info-faces)
 304
 305 (defcustom guix-package-info-auto-find-source nil
 306   "If non-nil, find a source file after pressing a \"Show\" button.
 307 If nil, just display the source file path without finding."
 308   :type 'boolean
 309   :group 'guix-package-info)
 310
 311 (defcustom guix-package-info-auto-download-source t
 312   "If nil, do not automatically download a source file if it doesn't exist.
 313 After pressing a \"Show\" button, a derivation of the package
 314 source is calculated and a store file path is displayed.  If this
 315 variable is non-nil and the source file does not exist in the
 316 store, it will be automatically downloaded (with a possible
 317 prompt depending on `guix-operation-confirm' variable)."
 318   :type 'boolean
 319   :group 'guix-package-info)
 320
 321 (defvar guix-package-info-download-buffer nil
 322   "Buffer from which a current download operation was performed.")
 323
 324 (defvar guix-package-info-output-format "%-10s"
 325   "String used to format output names of the packages.
 326 It should be a '%s'-sequence.  After inserting an output name
 327 formatted with this string, an action button is inserted.")
 328
 329 (defvar guix-package-info-obsolete-string "(This package is obsolete)"
 330   "String used if a package is obsolete.")
 331
 332 (define-button-type 'guix-package-location
 333   :supertype 'guix
 334   'face 'guix-package-info-location
 335   'help-echo "Find location of this package"
 336   'action (lambda (btn)
 337             (guix-find-location (button-label btn))))
 338
 339 (define-button-type 'guix-package-name
 340   :supertype 'guix
 341   'face 'guix-package-info-name-button
 342   'help-echo "Describe this package"
 343   'action (lambda (btn)
 344             (guix-buffer-get-display-entries-current
 345              'info guix-package-info-type
 346              (list (guix-ui-current-profile)
 347                    'name (button-label btn))
 348              'add)))
 349
 350 (define-button-type 'guix-package-source
 351   :supertype 'guix
 352   'face 'guix-package-info-source
 353   'help-echo ""
 354   'action (lambda (_)
 355             ;; As a source may not be a real URL (e.g., "mirror://..."),
 356             ;; no action is bound to a source button.
 357             (message "Yes, this is the source URL. What did you expect?")))
 358
 359 (defun guix-package-info-insert-heading (entry)
 360   "Insert package ENTRY heading (name specification) at point."
 361   (guix-insert-button
 362    (guix-package-entry->name-specification entry)
 363    'guix-package-name
 364    'face 'guix-package-info-heading))
 365
 366 (defmacro guix-package-info-define-insert-inputs (&optional type)
 367   "Define a face and a function for inserting package inputs.
 368 TYPE is a type of inputs.
 369 Function name is `guix-package-info-insert-TYPE-inputs'.
 370 Face name is `guix-package-info-TYPE-inputs'."
 371   (let* ((type-str (symbol-name type))
 372          (type-name (and type (concat type-str "-")))
 373          (type-desc (and type (concat type-str " ")))
 374          (face (intern (concat "guix-package-info-" type-name "inputs")))
 375          (btn  (intern (concat "guix-package-" type-name "input"))))
 376     `(progn
 377        (defface ,face
 378          '((t :inherit guix-package-info-name-button))
 379          ,(concat "Face used for " type-desc "inputs of a package.")
 380          :group 'guix-package-info-faces)
 381
 382        (define-button-type ',btn
 383          :supertype 'guix-package-name
 384          'face ',face))))
 385
 386 (guix-package-info-define-insert-inputs)
 387 (guix-package-info-define-insert-inputs native)
 388 (guix-package-info-define-insert-inputs propagated)
 389
 390 (defun guix-package-info-insert-outputs (outputs entry)
 391   "Insert OUTPUTS from package ENTRY at point."
 392   (and (guix-entry-value entry 'obsolete)
 393        (guix-package-info-insert-obsolete-text))
 394   (and (guix-entry-value entry 'non-unique)
 395        (guix-entry-value entry 'installed)
 396        (guix-package-info-insert-non-unique-text
 397         (guix-package-entry->name-specification entry)))
 398   (insert "\n")
 399   (dolist (output outputs)
 400     (guix-package-info-insert-output output entry)))
 401
 402 (defun guix-package-info-insert-obsolete-text ()
 403   "Insert a message about obsolete package at point."
 404   (guix-info-insert-indent)
 405   (guix-format-insert guix-package-info-obsolete-string
 406                       'guix-package-info-obsolete))
 407
 408 (defun guix-package-info-insert-non-unique-text (full-name)
 409   "Insert a message about non-unique package with FULL-NAME at point."
 410   (insert "\n")
 411   (guix-info-insert-indent)
 412   (insert "Installed outputs are displayed for a non-unique ")
 413   (guix-insert-button full-name 'guix-package-name)
 414   (insert " package."))
 415
 416 (defun guix-package-info-insert-output (output entry)
 417   "Insert OUTPUT at point.
 418 Make some fancy text with buttons and additional stuff if the
 419 current OUTPUT is installed (if there is such output in
 420 `installed' parameter of a package ENTRY)."
 421   (let* ((installed (guix-entry-value entry 'installed))
 422          (obsolete  (guix-entry-value entry 'obsolete))
 423          (installed-entry (cl-find-if
 424                            (lambda (entry)
 425                              (string= (guix-entry-value entry 'output)
 426                                       output))
 427                            installed))
 428          (action-type (if installed-entry 'delete 'install)))
 429     (guix-info-insert-indent)
 430     (guix-format-insert output
 431                         (if installed-entry
 432                             'guix-package-info-installed-outputs
 433                           'guix-package-info-uninstalled-outputs)
 434                         guix-package-info-output-format)
 435     (guix-package-info-insert-action-button action-type entry output)
 436     (when obsolete
 437       (guix-info-insert-indent)
 438       (guix-package-info-insert-action-button 'upgrade entry output))
 439     (insert "\n")
 440     (when installed-entry
 441       (guix-info-insert-entry installed-entry 'installed-output 2))))
 442
 443 (defun guix-package-info-insert-action-button (type entry output)
 444   "Insert button to process an action on a package OUTPUT at point.
 445 TYPE is one of the following symbols: `install', `delete', `upgrade'.
 446 ENTRY is an alist with package info."
 447   (let ((type-str  (capitalize (symbol-name type)))
 448         (full-name (guix-package-entry->name-specification entry output)))
 449     (guix-info-insert-action-button
 450      type-str
 451      (lambda (btn)
 452        (guix-process-package-actions
 453         (guix-ui-current-profile)
 454         `((,(button-get btn 'action-type) (,(button-get btn 'id)
 455                                            ,(button-get btn 'output))))
 456         (current-buffer)))
 457      (concat type-str " '" full-name "'")
 458      'action-type type
 459      'id (or (guix-entry-value entry 'package-id)
 460              (guix-entry-id entry))
 461      'output output)))
 462
 463 (defun guix-package-info-show-source (entry-id package-id)
 464   "Show file name of a package source in the current info buffer.
 465 Find the file if needed (see `guix-package-info-auto-find-source').
 466 ENTRY-ID is an ID of the current entry (package or output).
 467 PACKAGE-ID is an ID of the package which source to show."
 468   (let* ((entries (guix-buffer-current-entries))
 469          (entry   (guix-entry-by-id entry-id entries))
 470          (file    (guix-package-source-path package-id)))
 471     (or file
 472         (error "Couldn't define file name of the package source"))
 473     (let* ((new-entry (cons (cons 'source-file file)
 474                             entry))
 475            (new-entries (guix-replace-entry entry-id new-entry entries)))
 476       (setf (guix-buffer-item-entries guix-buffer-item)
 477             new-entries)
 478       (guix-buffer-redisplay-goto-button)
 479       (if (file-exists-p file)
 480           (if guix-package-info-auto-find-source
 481               (guix-find-file file)
 482             (message "The source store path is displayed."))
 483         (if guix-package-info-auto-download-source
 484             (guix-package-info-download-source package-id)
 485           (message "The source does not exist in the store."))))))
 486
 487 (defun guix-package-info-download-source (package-id)
 488   "Download a source of the package PACKAGE-ID."
 489   (setq guix-package-info-download-buffer (current-buffer))
 490   (guix-package-source-build-derivation
 491    package-id
 492    "The source does not exist in the store. Download it?"))
 493
 494 (defun guix-package-info-insert-source (source entry)
 495   "Insert SOURCE from package ENTRY at point.
 496 SOURCE is a list of URLs."
 497   (if (null source)
 498       (guix-format-insert nil)
 499     (let* ((source-file (guix-entry-value entry 'source-file))
 500            (entry-id    (guix-entry-id entry))
 501            (package-id  (or (guix-entry-value entry 'package-id)
 502                             entry-id)))
 503       (if (null source-file)
 504           (guix-info-insert-action-button
 505            "Show"
 506            (lambda (btn)
 507              (guix-package-info-show-source (button-get btn 'entry-id)
 508                                             (button-get btn 'package-id)))
 509            "Show the source store directory of the current package"
 510            'entry-id entry-id
 511            'package-id package-id)
 512         (unless (file-exists-p source-file)
 513           (guix-info-insert-action-button
 514            "Download"
 515            (lambda (btn)
 516              (guix-package-info-download-source
 517               (button-get btn 'package-id)))
 518            "Download the source into the store"
 519            'package-id package-id))
 520         (guix-info-insert-value-indent source-file 'guix-file))
 521       (guix-info-insert-value-indent source 'guix-package-source))))
 522
 523 (defun guix-package-info-redisplay-after-download ()
 524   "Redisplay an 'info' buffer after downloading the package source.
 525 This function is used to hide a \"Download\" button if needed."
 526   (when (buffer-live-p guix-package-info-download-buffer)
 527     (with-current-buffer guix-package-info-download-buffer
 528       (guix-buffer-redisplay-goto-button))
 529     (setq guix-package-info-download-buffer nil)))
 530
 531 (add-hook 'guix-after-source-download-hook
 532           'guix-package-info-redisplay-after-download)
 533
 534 \f
 535 ;;; Package 'list'
 536
 537 (guix-ui-list-define-interface package
 538   :buffer-name "*Guix Package List*"
 539   :format '((name guix-package-list-get-name 20 t)
 540             (version nil 10 nil)
 541             (outputs nil 13 t)
 542             (installed guix-package-list-get-installed-outputs 13 t)
 543             (synopsis guix-list-get-one-line 30 nil))
 544   :sort-key '(name)
 545   :marks '((install . ?I)
 546            (upgrade . ?U)
 547            (delete  . ?D)))
 548
 549 (let ((map guix-package-list-mode-map))
 550   (define-key map (kbd "B")   'guix-package-list-latest-builds)
 551   (define-key map (kbd "e")   'guix-package-list-edit)
 552   (define-key map (kbd "x")   'guix-package-list-execute)
 553   (define-key map (kbd "i")   'guix-package-list-mark-install)
 554   (define-key map (kbd "d")   'guix-package-list-mark-delete)
 555   (define-key map (kbd "U")   'guix-package-list-mark-upgrade)
 556   (define-key map (kbd "^")   'guix-package-list-mark-upgrades))
 557
 558 (defface guix-package-list-installed
 559   '((t :inherit guix-package-info-installed-outputs))
 560   "Face used if there are installed outputs for the current package."
 561   :group 'guix-package-list-faces)
 562
 563 (defface guix-package-list-obsolete
 564   '((t :inherit guix-package-info-obsolete))
 565   "Face used if a package is obsolete."
 566   :group 'guix-package-list-faces)
 567
 568 (defcustom guix-package-list-generation-marking-enabled nil
 569   "If non-nil, allow putting marks in a list with 'generation packages'.
 570
 571 By default this is disabled, because it may be confusing.  For
 572 example, a package is installed in some generation, so a user can
 573 mark it for deletion in the list of packages from this
 574 generation, but the package may not be installed in the latest
 575 generation, so actually it cannot be deleted.
 576
 577 If you managed to understand the explanation above or if you
 578 really know what you do or if you just don't care, you can set
 579 this variable to t.  It should not do much harm anyway (most
 580 likely)."
 581   :type 'boolean
 582   :group 'guix-package-list)
 583
 584 (defun guix-package-list-get-name (name entry)
 585   "Return NAME of the package ENTRY.
 586 Colorize it with `guix-package-list-installed' or
 587 `guix-package-list-obsolete' if needed."
 588   (guix-get-string name
 589                    (cond ((guix-entry-value entry 'obsolete)
 590                           'guix-package-list-obsolete)
 591                          ((guix-entry-value entry 'installed)
 592                           'guix-package-list-installed))))
 593
 594 (defun guix-package-list-get-installed-outputs (installed &optional _)
 595   "Return string with outputs from INSTALLED entries."
 596   (guix-get-string
 597    (mapcar (lambda (entry)
 598              (guix-entry-value entry 'output))
 599            installed)))
 600
 601 (defun guix-package-list-marking-check ()
 602   "Signal an error if marking is disabled for the current buffer."
 603   (when (and (not guix-package-list-generation-marking-enabled)
 604              (or (derived-mode-p 'guix-package-list-mode)
 605                  (derived-mode-p 'guix-output-list-mode))
 606              (eq (guix-ui-current-search-type) 'generation))
 607     (error "Action marks are disabled for lists of 'generation packages'")))
 608
 609 (defun guix-package-list-mark-outputs (mark default
 610                                        &optional prompt available)
 611   "Mark the current package with MARK and move to the next line.
 612 If PROMPT is non-nil, use it to ask a user for outputs from
 613 AVAILABLE list, otherwise mark all DEFAULT outputs."
 614   (let ((outputs (if prompt
 615                      (guix-completing-read-multiple
 616                       prompt available nil t)
 617                    default)))
 618     (apply #'guix-list--mark mark t outputs)))
 619
 620 (defun guix-package-list-mark-install (&optional arg)
 621   "Mark the current package for installation and move to the next line.
 622 With ARG, prompt for the outputs to install (several outputs may
 623 be separated with \",\")."
 624   (interactive "P")
 625   (guix-package-list-marking-check)
 626   (let* ((entry     (guix-list-current-entry))
 627          (all       (guix-entry-value entry 'outputs))
 628          (installed (guix-package-installed-outputs entry))
 629          (available (cl-set-difference all installed :test #'string=)))
 630     (or available
 631         (user-error "This package is already installed"))
 632     (guix-package-list-mark-outputs
 633      'install '("out")
 634      (and arg "Output(s) to install: ")
 635      available)))
 636
 637 (defun guix-package-list-mark-delete (&optional arg)
 638   "Mark the current package for deletion and move to the next line.
 639 With ARG, prompt for the outputs to delete (several outputs may
 640 be separated with \",\")."
 641   (interactive "P")
 642   (guix-package-list-marking-check)
 643   (let* ((entry (guix-list-current-entry))
 644          (installed (guix-package-installed-outputs entry)))
 645     (or installed
 646         (user-error "This package is not installed"))
 647     (guix-package-list-mark-outputs
 648      'delete installed
 649      (and arg "Output(s) to delete: ")
 650      installed)))
 651
 652 (defun guix-package-list-mark-upgrade (&optional arg)
 653   "Mark the current package for upgrading and move to the next line.
 654 With ARG, prompt for the outputs to upgrade (several outputs may
 655 be separated with \",\")."
 656   (interactive "P")
 657   (guix-package-list-marking-check)
 658   (let* ((entry (guix-list-current-entry))
 659          (installed (guix-package-installed-outputs entry)))
 660     (or installed
 661         (user-error "This package is not installed"))
 662     (when (or (guix-entry-value entry 'obsolete)
 663               (y-or-n-p "This package is not obsolete.  Try to upgrade it anyway? "))
 664       (guix-package-list-mark-outputs
 665        'upgrade installed
 666        (and arg "Output(s) to upgrade: ")
 667        installed))))
 668
 669 (defun guix-package-mark-upgrades (fun)
 670   "Mark all obsolete packages for upgrading.
 671 Use FUN to perform marking of the current line.  FUN should
 672 take an entry as argument."
 673   (guix-package-list-marking-check)
 674   (let ((obsolete (cl-remove-if-not
 675                    (lambda (entry)
 676                      (guix-entry-value entry 'obsolete))
 677                    (guix-buffer-current-entries))))
 678     (guix-list-for-each-line
 679      (lambda ()
 680        (let* ((id (guix-list-current-id))
 681               (entry (cl-find-if
 682                       (lambda (entry)
 683                         (equal id (guix-entry-id entry)))
 684                       obsolete)))
 685          (when entry
 686            (funcall fun entry)))))))
 687
 688 (defun guix-package-list-mark-upgrades ()
 689   "Mark all obsolete packages for upgrading."
 690   (interactive)
 691   (guix-package-mark-upgrades
 692    (lambda (entry)
 693      (apply #'guix-list--mark
 694             'upgrade nil
 695             (guix-package-installed-outputs entry)))))
 696
 697 (defun guix-package-execute-actions (fun)
 698   "Perform actions on the marked packages.
 699 Use FUN to define actions suitable for `guix-process-package-actions'.
 700 FUN should take action-type as argument."
 701   (let ((actions (delq nil
 702                        (mapcar fun '(install delete upgrade)))))
 703     (if actions
 704         (guix-process-package-actions (guix-ui-current-profile)
 705                                       actions (current-buffer))
 706       (user-error "No operations specified"))))
 707
 708 (defun guix-package-list-execute ()
 709   "Perform actions on the marked packages."
 710   (interactive)
 711   (guix-package-execute-actions #'guix-package-list-make-action))
 712
 713 (defun guix-package-list-make-action (action-type)
 714   "Return action specification for the packages marked with ACTION-TYPE.
 715 Return nil, if there are no packages marked with ACTION-TYPE.
 716 The specification is suitable for `guix-process-package-actions'."
 717   (let ((specs (guix-list-get-marked-args action-type)))
 718     (and specs (cons action-type specs))))
 719
 720 (defun guix-package-list-edit ()
 721   "Go to the location of the current package."
 722   (interactive)
 723   (guix-edit (guix-list-current-id)))
 724
 725 (defun guix-package-list-latest-builds (number &rest args)
 726   "Display latest NUMBER of Hydra builds of the current package.
 727 Interactively, prompt for NUMBER.  With prefix argument, prompt
 728 for all ARGS."
 729   (interactive
 730    (let ((entry (guix-list-current-entry)))
 731      (guix-hydra-build-latest-prompt-args
 732       :job (guix-package-name-specification
 733             (guix-entry-value entry 'name)
 734             (guix-entry-value entry 'version)))))
 735   (apply #'guix-hydra-latest-builds number args))
 736
 737 \f
 738 ;;; Output 'info'
 739
 740 (guix-ui-info-define-interface output
 741   :buffer-name "*Guix Package Info*"
 742   :format '((name format (format guix-package-info-name))
 743             (version format guix-output-info-insert-version)
 744             (output format guix-output-info-insert-output)
 745             (synopsis simple (indent guix-package-info-synopsis))
 746             (source simple guix-package-info-insert-source)
 747             (path simple (indent guix-file))
 748             (dependencies simple (indent guix-file))
 749             (location format (format guix-package-location))
 750             (home-url format (format guix-url))
 751             (license format (format guix-package-info-license))
 752             (inputs format (format guix-package-input))
 753             (native-inputs format (format guix-package-native-input))
 754             (propagated-inputs format
 755                                (format guix-package-propagated-input))
 756             (description simple (indent guix-package-info-description)))
 757   :titles guix-package-info-titles
 758   :required '(id package-id installed non-unique))
 759
 760 (defun guix-output-info-insert-version (version entry)
 761   "Insert output VERSION and obsolete text if needed at point."
 762   (guix-info-insert-value-format version
 763                                  'guix-package-info-version)
 764   (and (guix-entry-value entry 'obsolete)
 765        (guix-package-info-insert-obsolete-text)))
 766
 767 (defun guix-output-info-insert-output (output entry)
 768   "Insert OUTPUT and action buttons at point."
 769   (let* ((installed   (guix-entry-value entry 'installed))
 770          (obsolete    (guix-entry-value entry 'obsolete))
 771          (action-type (if installed 'delete 'install)))
 772     (guix-info-insert-value-format
 773      output
 774      (if installed
 775          'guix-package-info-installed-outputs
 776        'guix-package-info-uninstalled-outputs))
 777     (guix-info-insert-indent)
 778     (guix-package-info-insert-action-button action-type entry output)
 779     (when obsolete
 780       (guix-info-insert-indent)
 781       (guix-package-info-insert-action-button 'upgrade entry output))))
 782
 783 \f
 784 ;;; Output 'list'
 785
 786 (guix-ui-list-define-interface output
 787   :buffer-name "*Guix Package List*"
 788   :describe-function 'guix-output-list-describe
 789   :format '((name guix-package-list-get-name 20 t)
 790             (version nil 10 nil)
 791             (output nil 9 t)
 792             (installed nil 12 t)
 793             (synopsis guix-list-get-one-line 30 nil))
 794   :required '(id package-id)
 795   :sort-key '(name)
 796   :marks '((install . ?I)
 797            (upgrade . ?U)
 798            (delete  . ?D)))
 799
 800 (let ((map guix-output-list-mode-map))
 801   (define-key map (kbd "B")   'guix-package-list-latest-builds)
 802   (define-key map (kbd "e")   'guix-output-list-edit)
 803   (define-key map (kbd "x")   'guix-output-list-execute)
 804   (define-key map (kbd "i")   'guix-output-list-mark-install)
 805   (define-key map (kbd "d")   'guix-output-list-mark-delete)
 806   (define-key map (kbd "U")   'guix-output-list-mark-upgrade)
 807   (define-key map (kbd "^")   'guix-output-list-mark-upgrades))
 808
 809 (defun guix-output-list-mark-install ()
 810   "Mark the current output for installation and move to the next line."
 811   (interactive)
 812   (guix-package-list-marking-check)
 813   (let* ((entry     (guix-list-current-entry))
 814          (installed (guix-entry-value entry 'installed)))
 815     (if installed
 816         (user-error "This output is already installed")
 817       (guix-list--mark 'install t))))
 818
 819 (defun guix-output-list-mark-delete ()
 820   "Mark the current output for deletion and move to the next line."
 821   (interactive)
 822   (guix-package-list-marking-check)
 823   (let* ((entry     (guix-list-current-entry))
 824          (installed (guix-entry-value entry 'installed)))
 825     (if installed
 826         (guix-list--mark 'delete t)
 827       (user-error "This output is not installed"))))
 828
 829 (defun guix-output-list-mark-upgrade ()
 830   "Mark the current output for upgrading and move to the next line."
 831   (interactive)
 832   (guix-package-list-marking-check)
 833   (let* ((entry     (guix-list-current-entry))
 834          (installed (guix-entry-value entry 'installed)))
 835     (or installed
 836         (user-error "This output is not installed"))
 837     (when (or (guix-entry-value entry 'obsolete)
 838               (y-or-n-p "This output is not obsolete.  Try to upgrade it anyway? "))
 839       (guix-list--mark 'upgrade t))))
 840
 841 (defun guix-output-list-mark-upgrades ()
 842   "Mark all obsolete package outputs for upgrading."
 843   (interactive)
 844   (guix-package-mark-upgrades
 845    (lambda (_) (guix-list--mark 'upgrade))))
 846
 847 (defun guix-output-list-execute ()
 848   "Perform actions on the marked outputs."
 849   (interactive)
 850   (guix-package-execute-actions #'guix-output-list-make-action))
 851
 852 (defun guix-output-list-make-action (action-type)
 853   "Return action specification for the outputs marked with ACTION-TYPE.
 854 Return nil, if there are no outputs marked with ACTION-TYPE.
 855 The specification is suitable for `guix-process-output-actions'."
 856   (let ((ids (guix-list-get-marked-id-list action-type)))
 857     (and ids (cons action-type
 858                    (mapcar #'guix-package-id-and-output-by-output-id
 859                            ids)))))
 860
 861 (defun guix-output-list-describe (ids)
 862   "Describe outputs with IDS (list of output identifiers).
 863 See `guix-package-info-type'."
 864   (if (eq guix-package-info-type 'output)
 865       (guix-buffer-get-display-entries
 866        'info 'output
 867        (cl-list* (guix-ui-current-profile) 'id ids)
 868        'add)
 869     (let ((pids (mapcar (lambda (oid)
 870                           (car (guix-package-id-and-output-by-output-id
 871                                 oid)))
 872                         ids)))
 873       (guix-buffer-get-display-entries
 874        'info 'package
 875        (cl-list* (guix-ui-current-profile)
 876                  'id (cl-remove-duplicates pids))
 877        'add))))
 878
 879 (defun guix-output-list-edit ()
 880   "Go to the location of the current package."
 881   (interactive)
 882   (guix-edit (guix-entry-value (guix-list-current-entry)
 883                                'package-id)))
 884
 885 \f
 886 ;;; Interactive commands
 887
 888 (defvar guix-package-search-params '(name synopsis description)
 889   "Default list of package parameters for searching by regexp.")
 890
 891 (defvar guix-package-search-history nil
 892   "A history of minibuffer prompts.")
 893
 894 ;;;###autoload
 895 (defun guix-search-by-name (name &optional profile)
 896   "Search for Guix packages by NAME.
 897 NAME is a string with name specification.  It may optionally contain
 898 a version number.  Examples: \"guile\", \"guile-2.0.11\".
 899
 900 If PROFILE is nil, use `guix-current-profile'.
 901 Interactively with prefix, prompt for PROFILE."
 902   (interactive
 903    (list (read-string "Package name: " nil 'guix-package-search-history)
 904          (guix-ui-read-profile)))
 905   (guix-package-get-display profile 'name name))
 906
 907 ;;;###autoload
 908 (defun guix-search-by-regexp (regexp &optional params profile)
 909   "Search for Guix packages by REGEXP.
 910 PARAMS are package parameters that should be searched.
 911 If PARAMS are not specified, use `guix-package-search-params'.
 912
 913 If PROFILE is nil, use `guix-current-profile'.
 914 Interactively with prefix, prompt for PROFILE."
 915   (interactive
 916    (list (read-regexp "Regexp: " nil 'guix-package-search-history)
 917          nil (guix-ui-read-profile)))
 918   (guix-package-get-display profile 'regexp regexp
 919                             (or params guix-package-search-params)))
 920
 921 ;;;###autoload
 922 (defun guix-installed-packages (&optional profile)
 923   "Display information about installed Guix packages.
 924 If PROFILE is nil, use `guix-current-profile'.
 925 Interactively with prefix, prompt for PROFILE."
 926   (interactive (list (guix-ui-read-profile)))
 927   (guix-package-get-display profile 'installed))
 928
 929 ;;;###autoload
 930 (defun guix-obsolete-packages (&optional profile)
 931   "Display information about obsolete Guix packages.
 932 If PROFILE is nil, use `guix-current-profile'.
 933 Interactively with prefix, prompt for PROFILE."
 934   (interactive (list (guix-ui-read-profile)))
 935   (guix-package-get-display profile 'obsolete))
 936
 937 ;;;###autoload
 938 (defun guix-all-available-packages (&optional profile)
 939   "Display information about all available Guix packages.
 940 If PROFILE is nil, use `guix-current-profile'.
 941 Interactively with prefix, prompt for PROFILE."
 942   (interactive (list (guix-ui-read-profile)))
 943   (guix-package-get-display profile 'all-available))
 944
 945 ;;;###autoload
 946 (defun guix-newest-available-packages (&optional profile)
 947   "Display information about the newest available Guix packages.
 948 If PROFILE is nil, use `guix-current-profile'.
 949 Interactively with prefix, prompt for PROFILE."
 950   (interactive (list (guix-ui-read-profile)))
 951   (guix-package-get-display profile 'newest-available))
 952
 953 (provide 'guix-ui-package)
 954
 955 ;;; guix-ui-package.el ends here