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