emacs: Add support for displaying outputs.

Suggested by Taylan Ulrich Bayirli/Kammer and Ludovic Courtès.

* emacs/guix-base.el (guix-param-titles): Add output titles.
  (guix-messages): Add output messages.
  (guix-get-package-id-and-output-by-output-id): New procedure.
  (guix-define-buffer-type): Add ':buffer-name' key.
* emacs/guix-info.el: Add "output-info" buffer type.
  (guix-info-insert-methods): Add output methods.
  (guix-info-displayed-params): Add output params.
  (guix-output-info-insert-version, guix-output-info-insert-output): New
  procedures.
* emacs/guix-list.el: Add "output-list" buffer type.
  (guix-list-column-format): Add output formats.
  (guix-list-column-value-methods): Add output methods.
  (guix-package-list-type): New variable.
  (guix-generation-list-show-packages): Use it.
  (guix-package-list-marking-check): Use 'guix-output-list-mode'.
  (guix-list-mark-package-upgrades): New procedure.
  (guix-package-list-mark-upgrades): Use it.
  (guix-list-execute-package-actions): New procedure.
  (guix-package-list-execute): Use it.
  (guix-list-describe-maybe): New procedure.
  (guix-list-describe): Use it.
  (guix-output-list-mark-install, guix-output-list-mark-delete,
  guix-output-list-mark-upgrade, guix-output-list-mark-upgrades,
  guix-output-list-execute, guix-output-list-make-action,
  guix-output-list-describe): New procedures.
  (guix-output-list-describe-type): New variable.
* emacs/guix.el (guix-get-show-packages): Use 'guix-package-list-type'.
* doc/emacs.texi (emacs Commands): Mention 'guix-package-list-type'.
  (emacs List buffer): Adjust accordingly.
  (emacs Info buffer): Likewise.
  (emacs Buffer Names): New node.
  (emacs Keymaps): Add keymaps for output buffers.

4 files changed, 277 insertions, 34 deletions

diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index 049d976912..98ee315688 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -87,6 +87,22 @@ Interactively, prompt for PATH.  With prefix, use
      (path              . "Installed path")
      (dependencies      . "Dependencies")
      (output            . "Output"))
+    (output
+     (id                . "ID")
+     (name              . "Name")
+     (version           . "Version")
+     (license           . "License")
+     (synopsis          . "Synopsis")
+     (description       . "Description")
+     (home-url          . "Home page")
+     (output            . "Output")
+     (inputs            . "Inputs")
+     (native-inputs     . "Native inputs")
+     (propagated-inputs . "Propagated inputs")
+     (location          . "Location")
+     (installed         . "Installed")
+     (path              . "Installed path")
+     (dependencies      . "Dependencies"))
     (generation
      (id                . "ID")
      (number            . "Number")
@@ -130,6 +146,14 @@ Each element of the list has a form:
                 (equal id (guix-get-key-val entry 'id)))
               entries))
 
+(defun guix-get-package-id-and-output-by-output-id (oid)
+  "Return list (PACKAGE-ID OUTPUT) by output id OID."
+  (cl-multiple-value-bind (pid-str output)
+      (split-string oid ":")
+    (let ((pid (string-to-number pid-str)))
+      (list (if (= 0 pid) pid-str pid)
+            output))))
+
 
 ;;; Location of the packages
 
@@ -227,6 +251,9 @@ The following stuff should be defined outside this macro:
 Remaining argument (ARGS) should have a form [KEYWORD VALUE] ...  The
 following keywords are available:
 
+  - `:buffer-name' - default value for the defined
+    `guix-TYPE-buffer-name' variable.
+
   - `:required' - default value for the defined
     `guix-TYPE-required-params' variable.
 
@@ -252,6 +279,7 @@ following keywords are available:
          (revert-var     (intern (concat prefix "-revert-no-confirm")))
          (history-var    (intern (concat prefix "-history-size")))
          (params-var     (intern (concat prefix "-required-params")))
+         (buf-name-val   (format "*Guix %s %s*" Entry-type-str Buf-type-str))
          (revert-val     nil)
          (history-val    20)
          (params-val     '(id)))
@@ -262,6 +290,7 @@ following keywords are available:
 	(`:required     (setq params-val (pop args)))
 	(`:history-size (setq history-val (pop args)))
 	(`:revert       (setq revert-val (pop args)))
+        (`:buffer-name  (setq buf-name-val (pop args)))
 	(_ (pop args))))
 
     `(progn
@@ -270,8 +299,7 @@ following keywords are available:
          :prefix ,(concat prefix "-")
          :group ',(intern (concat "guix-" buf-type-str)))
 
-       (defcustom ,buf-name-var ,(format "*Guix %s %s*"
-                                         Entry-type-str Buf-type-str)
+       (defcustom ,buf-name-var ,buf-name-val
          ,(concat "Default name of the " buf-str " for displaying " entry-str ".")
          :type 'string
          :group ',group)
@@ -470,8 +498,8 @@ This function will not update the information, use
       (many "%d newest available packages." count))
      (installed
       (0 "No installed packages.")
-      (1 "A single installed package.")
-      (many "%d installed packages." count))
+      (1 "A single package installed.")
+      (many "%d packages installed." count))
      (obsolete
       (0 "No obsolete packages.")
       (1 "A single obsolete package.")
@@ -480,6 +508,39 @@ This function will not update the information, use
       (0 "No packages installed in generation %d." val)
       (1 "A single package installed in generation %d." val)
       (many "%d packages installed in generation %d." count val)))
+    (output
+     (id
+      (0 "Package outputs not found.")
+      (1 "")
+      (many "%d package outputs." count))
+     (name
+      (0 "The package output '%s' not found." val)
+      (1 "A single package output with name '%s'." val)
+      (many "%d package outputs with '%s' name." count val))
+     (regexp
+      (0 "No package outputs matching '%s'." val)
+      (1 "A single package output matching '%s'." val)
+      (many "%d package outputs matching '%s'." count val))
+     (all-available
+      (0 "No package outputs are available for some reason.")
+      (1 "A single available package output (that's strange).")
+      (many "%d available package outputs." count))
+     (newest-available
+      (0 "No package outputs are available for some reason.")
+      (1 "A single newest available package output (that's strange).")
+      (many "%d newest available package outputs." count))
+     (installed
+      (0 "No installed package outputs.")
+      (1 "A single package output installed.")
+      (many "%d package outputs installed." count))
+     (obsolete
+      (0 "No obsolete package outputs.")
+      (1 "A single obsolete package output.")
+      (many "%d obsolete package outputs." count))
+     (generation
+      (0 "No package outputs installed in generation %d." val)
+      (1 "A single package output installed in generation %d." val)
+      (many "%d package outputs installed in generation %d." count val)))
     (generation
      (id
       (0 "Generations not found.")
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index 05281e7be7..f9c17b2d13 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -117,6 +117,23 @@ number of characters, it will be split into several lines.")
                         guix-info-insert-title-simple)
      (dependencies      guix-package-info-insert-output-dependencies
                         guix-info-insert-title-simple))
+    (output
+     (name              guix-package-info-name)
+     (version           guix-output-info-insert-version)
+     (output            guix-output-info-insert-output)
+     (path              guix-package-info-insert-output-path
+                        guix-info-insert-title-simple)
+     (dependencies      guix-package-info-insert-output-dependencies
+                        guix-info-insert-title-simple)
+     (license           guix-package-info-license)
+     (synopsis          guix-package-info-synopsis)
+     (description       guix-package-info-insert-description
+                        guix-info-insert-title-simple)
+     (home-url          guix-info-insert-url)
+     (inputs            guix-package-info-insert-inputs)
+     (native-inputs     guix-package-info-insert-native-inputs)
+     (propagated-inputs guix-package-info-insert-propagated-inputs)
+     (location          guix-package-info-insert-location))
     (generation
      (number            guix-generation-info-insert-number)
      (path              guix-info-insert-file-path)
@@ -141,6 +158,8 @@ argument.")
 (defvar guix-info-displayed-params
   '((package name version synopsis outputs location home-url
              license inputs native-inputs propagated-inputs description)
+    (output name version output synopsis path dependencies location home-url
+            license inputs native-inputs propagated-inputs description)
     (installed path dependencies)
     (generation number prev-number time path))
   "List of displayed entry parameters.
@@ -520,9 +539,38 @@ ENTRY is an alist with package info."
   "Insert PATH of the installed output."
   (guix-info-insert-val-simple path #'guix-info-insert-file-path))
 
-(defun guix-package-info-insert-output-dependencies (deps &optional _)
-  "Insert dependencies DEPS of the installed output."
-  (guix-info-insert-val-simple deps #'guix-info-insert-file-path))
+(defalias 'guix-package-info-insert-output-dependencies
+  'guix-package-info-insert-output-path)
+
+
+;;; Displaying outputs
+
+(guix-define-buffer-type info output
+  :buffer-name "*Guix Package Info*"
+  :required (id package-id installed non-unique))
+
+(defun guix-output-info-insert-version (version entry)
+  "Insert output VERSION and obsolete text if needed at point."
+  (guix-info-insert-val-default version
+                                'guix-package-info-version)
+  (and (guix-get-key-val entry 'obsolete)
+       (guix-package-info-insert-obsolete-text)))
+
+(defun guix-output-info-insert-output (output entry)
+  "Insert OUTPUT and action buttons at point."
+  (let* ((installed (guix-get-key-val entry 'installed))
+         (obsolete  (guix-get-key-val entry 'obsolete))
+         (action-type (if installed 'delete 'install)))
+    (guix-info-insert-val-default
+     output
+     (if installed
+         'guix-package-info-installed-outputs
+       'guix-package-info-uninstalled-outputs))
+    (guix-info-insert-indent)
+    (guix-package-info-insert-action-button action-type entry output)
+    (when obsolete
+      (guix-info-insert-indent)
+      (guix-package-info-insert-action-button 'upgrade entry output))))
 
 
 ;;; Displaying generations
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index 3732d9b627..3342175fe3 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -55,6 +55,12 @@ entries, he will be prompted for confirmation."
      (outputs 13 t)
      (installed 13 t)
      (synopsis 30 nil))
+    (output
+     (name 20 t)
+     (version 10 nil)
+     (output 9 t)
+     (installed 12 t)
+     (synopsis 30 nil))
     (generation
      (number 5
              ,(lambda (a b) (guix-list-sort-numerically 0 a b))
@@ -82,6 +88,10 @@ this list have a priority.")
      (synopsis    . guix-list-get-one-line)
      (description . guix-list-get-one-line)
      (installed   . guix-package-list-get-installed-outputs))
+    (output
+     (name        . guix-package-list-get-name)
+     (synopsis    . guix-list-get-one-line)
+     (description . guix-list-get-one-line))
     (generation
      (time . guix-list-get-time)
      (path . guix-list-get-file-path)))
@@ -420,20 +430,23 @@ This macro defines the following functions:
 
 (put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
 
+(defun guix-list-describe-maybe (entry-type ids)
+  "Describe ENTRY-TYPE entries in info buffer using list of IDS."
+  (let ((count (length ids)))
+    (when (or (<= count guix-list-describe-warning-count)
+              (y-or-n-p (format "Do you really want to describe %d entries? "
+                                count)))
+      (apply #'guix-get-show-entries 'info entry-type 'id ids))))
+
 (defun guix-list-describe (&optional arg)
   "Describe entries marked with a general mark.
 If no entries are marked, describe the current entry.
 With prefix (if ARG is non-nil), describe entries marked with any mark."
   (interactive "P")
-  (let* ((ids (or (apply #'guix-list-get-marked-id-list
-                         (unless arg '(general)))
-                  (list (guix-list-current-id))))
-         (count (length ids)))
-    (when (or (<= count guix-list-describe-warning-count)
-              (y-or-n-p (format "Do you really want to describe %d entries? "
-                                count)))
-      (apply #'guix-get-show-entries
-             'info guix-entry-type 'id ids))))
+  (let ((ids (or (apply #'guix-list-get-marked-id-list
+                        (unless arg '(general)))
+                 (list (guix-list-current-id)))))
+    (guix-list-describe-maybe guix-entry-type ids)))
 
 
 ;;; Displaying packages
@@ -456,6 +469,15 @@ With prefix (if ARG is non-nil), describe entries marked with any mark."
   "Face used if a package is obsolete."
   :group 'guix-package-list)
 
+(defcustom guix-package-list-type 'output
+  "Define how to display packages in a list buffer.
+May be a symbol `package' or `output' (if `output', display each
+output on a separate line; if `package', display each package on
+a separate line)."
+  :type '(choice (const :tag "List of packages" package)
+                 (const :tag "List of outputs" output))
+  :group 'guix-package-list)
+
 (defcustom guix-package-list-generation-marking-enabled nil
   "If non-nil, allow putting marks in a list with 'generation packages'.
 
@@ -499,7 +521,8 @@ Colorize it with `guix-package-list-installed' or
 (defun guix-package-list-marking-check ()
   "Signal an error if marking is disabled for the current buffer."
   (when (and (not guix-package-list-generation-marking-enabled)
-             (derived-mode-p 'guix-package-list-mode)
+             (or (derived-mode-p 'guix-package-list-mode)
+                 (derived-mode-p 'guix-output-list-mode))
              (eq guix-search-type 'generation))
     (error "Action marks are disabled for lists of 'generation packages'")))
 
@@ -563,9 +586,10 @@ be separated with \",\")."
        (and arg "Output(s) to upgrade: ")
        installed))))
 
-(defun guix-package-list-mark-upgrades ()
-  "Mark all obsolete packages for upgrading."
-  (interactive)
+(defun guix-list-mark-package-upgrades (fun)
+  "Mark all obsolete packages for upgrading.
+Use FUN to perform marking of the current line.  FUN should
+accept an entry as argument."
   (guix-package-list-marking-check)
   (let ((obsolete (cl-remove-if-not
                    (lambda (entry)
@@ -579,20 +603,32 @@ be separated with \",\")."
                         (equal id (guix-get-key-val entry 'id)))
                       obsolete)))
          (when entry
-           (apply #'guix-list-mark
-                  'upgrade nil
-                  (guix-get-installed-outputs entry))))))))
+           (funcall fun entry)))))))
 
-(defun guix-package-list-execute ()
-  "Perform actions on the marked packages."
+(defun guix-package-list-mark-upgrades ()
+  "Mark all obsolete packages for upgrading."
   (interactive)
+  (guix-list-mark-package-upgrades
+   (lambda (entry)
+     (apply #'guix-list-mark
+            'upgrade nil
+            (guix-get-installed-outputs entry)))))
+
+(defun guix-list-execute-package-actions (fun)
+  "Perform actions on the marked packages.
+Use FUN to define actions suitable for `guix-process-package-actions'.
+FUN should accept action-type as argument."
   (let ((actions (delq nil
-                       (mapcar #'guix-package-list-make-action
-                               '(install delete upgrade)))))
+                       (mapcar fun '(install delete upgrade)))))
     (if actions
         (apply #'guix-process-package-actions actions)
       (user-error "No operations specified"))))
 
+(defun guix-package-list-execute ()
+  "Perform actions on the marked packages."
+  (interactive)
+  (guix-list-execute-package-actions #'guix-package-list-make-action))
+
 (defun guix-package-list-make-action (action-type)
   "Return action specification for the packages marked with ACTION-TYPE.
 Return nil, if there are no packages marked with ACTION-TYPE.
@@ -601,6 +637,104 @@ The specification is suitable for `guix-process-package-actions'."
     (and specs (cons action-type specs))))
 
 
+;;; Displaying outputs
+
+(guix-define-buffer-type list output
+  :buffer-name "*Guix Package List*")
+
+(guix-list-define-entry-type output
+  :sort-key name
+  :marks ((install . ?I)
+          (upgrade . ?U)
+          (delete  . ?D)))
+
+(defcustom guix-output-list-describe-type 'package
+  "Define how to describe outputs in a list buffer.
+May be a symbol `package' or `output' (if `output', describe only
+marked outputs; if `package', describe all outputs of the marked
+packages)."
+  :type '(choice (const :tag "Describe packages" package)
+                 (const :tag "Describe outputs" output))
+  :group 'guix-output-list)
+
+(let ((map guix-output-list-mode-map))
+  (define-key map (kbd "RET") 'guix-output-list-describe)
+  (define-key map (kbd "x")   'guix-output-list-execute)
+  (define-key map (kbd "i")   'guix-output-list-mark-install)
+  (define-key map (kbd "d")   'guix-output-list-mark-delete)
+  (define-key map (kbd "U")   'guix-output-list-mark-upgrade)
+  (define-key map (kbd "^")   'guix-output-list-mark-upgrades))
+
+(defun guix-output-list-mark-install ()
+  "Mark the current output for installation and move to the next line."
+  (interactive)
+  (guix-package-list-marking-check)
+  (let* ((entry     (guix-list-current-entry))
+         (installed (guix-get-key-val entry 'installed)))
+    (if installed
+        (user-error "This output is already installed")
+      (guix-list-mark 'install t))))
+
+(defun guix-output-list-mark-delete ()
+  "Mark the current output for deletion and move to the next line."
+  (interactive)
+  (guix-package-list-marking-check)
+  (let* ((entry     (guix-list-current-entry))
+         (installed (guix-get-key-val entry 'installed)))
+    (if installed
+        (guix-list-mark 'delete t)
+      (user-error "This output is not installed"))))
+
+(defun guix-output-list-mark-upgrade ()
+  "Mark the current output for deletion and move to the next line."
+  (interactive)
+  (guix-package-list-marking-check)
+  (let* ((entry     (guix-list-current-entry))
+         (installed (guix-get-key-val entry 'installed)))
+    (or installed
+        (user-error "This output is not installed"))
+    (when (or (guix-get-key-val entry 'obsolete)
+              (y-or-n-p "This output is not obsolete.  Try to upgrade it anyway? "))
+      (guix-list-mark 'upgrade t))))
+
+(defun guix-output-list-mark-upgrades ()
+  "Mark all obsolete package outputs for upgrading."
+  (interactive)
+  (guix-list-mark-package-upgrades
+   (lambda (_) (guix-list-mark 'upgrade))))
+
+(defun guix-output-list-execute ()
+  "Perform actions on the marked outputs."
+  (interactive)
+  (guix-list-execute-package-actions #'guix-output-list-make-action))
+
+(defun guix-output-list-make-action (action-type)
+  "Return action specification for the outputs marked with ACTION-TYPE.
+Return nil, if there are no outputs marked with ACTION-TYPE.
+The specification is suitable for `guix-process-output-actions'."
+  (let ((ids (guix-list-get-marked-id-list action-type)))
+    (and ids (cons action-type
+                   (mapcar #'guix-get-package-id-and-output-by-output-id
+                           ids)))))
+
+(defun guix-output-list-describe (&optional arg)
+  "Describe outputs or packages marked with a general mark.
+If no entries are marked, describe the current output or package.
+With prefix (if ARG is non-nil), describe entries marked with any mark.
+Also see `guix-output-list-describe-type'."
+  (interactive "P")
+  (if (eq guix-output-list-describe-type 'output)
+      (guix-list-describe arg)
+    (let* ((oids (or (apply #'guix-list-get-marked-id-list
+                            (unless arg '(general)))
+                     (list (guix-list-current-id))))
+           (pids (mapcar (lambda (oid)
+                           (car (guix-get-package-id-and-output-by-output-id
+                                 oid)))
+                         oids)))
+      (guix-list-describe-maybe 'package (cl-remove-duplicates pids)))))
+
+
 ;;; Displaying generations
 
 (guix-define-buffer-type list generation)
@@ -618,7 +752,7 @@ The specification is suitable for `guix-process-package-actions'."
 (defun guix-generation-list-show-packages ()
   "List installed packages for the generation at point."
   (interactive)
-  (guix-get-show-entries 'list 'package 'generation
+  (guix-get-show-entries 'list guix-package-list-type 'generation
                          (guix-list-current-id)))
 
 (provide 'guix-list)
diff --git a/emacs/guix.el b/emacs/guix.el
index 621dd3b22c..f6e2023ea5 100644
--- a/emacs/guix.el
+++ b/emacs/guix.el
@@ -58,24 +58,24 @@ SEARCH-VALS.
 Results are displayed in the list buffer, unless a single package
 is found and `guix-list-single-package' is nil."
   (let* ((list-params (guix-get-params-for-receiving
-                       'list 'package))
-         (packages (guix-get-entries 'package
+                       'list guix-package-list-type))
+         (packages (guix-get-entries guix-package-list-type
                                      search-type search-vals
                                      list-params)))
     (if (or guix-list-single-package
             (cdr packages))
-        (guix-set-buffer packages 'list 'package
+        (guix-set-buffer packages 'list guix-package-list-type
                          search-type search-vals)
       (let* ((info-params (guix-get-params-for-receiving
-                           'info 'package))
+                           'info guix-package-list-type))
              (packages (if (equal list-params info-params)
                            packages
                          ;; If we don't have required info, we should
                          ;; receive it again
-                         (guix-get-entries 'package
+                         (guix-get-entries guix-package-list-type
                                            search-type search-vals
                                            info-params))))
-        (guix-set-buffer packages 'info 'package
+        (guix-set-buffer packages 'info guix-package-list-type
                          search-type search-vals)))))
 
 (defun guix-get-show-generations (search-type &rest search-vals)