~ruther/guix-local

a54a237b5ff714102056079218f1322ced51620b — Alex Kost 11 years ago 81b339f
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.
5 files changed, 329 insertions(+), 41 deletions(-)

M doc/emacs.texi
M emacs/guix-base.el
M emacs/guix-info.el
M emacs/guix-list.el
M emacs/guix.el
M doc/emacs.texi => doc/emacs.texi +52 -7
@@ 104,6 104,14 @@ many last generations.

@end table

By default commands for displaying packages display each output on a
separate line.  If you prefer to see a list of packages (i.e.@: a list
with a package per line), use the following setting:

@example
(setq guix-package-list-type 'package)
@end example

It is possible to change the currently used profile with
@kbd{M-x@tie{}guix-set-current-profile}.  This has the same effect as
specifying @code{--profile} option for @command{guix package}


@@ 177,18 185,15 @@ A ``package-list'' buffer additionally provides the following bindings:
Describe marked packages (display available information in a
``package-info'' buffer).
@item i
Mark "out" of the current package for installation (with prefix, prompt
for output(s) to install).
Mark the current package for installation.
@item d
Mark all installed outputs of the current package for deletion (with
prefix, prompt for output(s) to delete).
Mark the current package for deletion.
@item U
Mark all installed outputs of the current package for upgrading (with
prefix, prompt for output(s) to upgrade).
Mark the current package for upgrading.
@item ^
Mark all obsolete packages for upgrading.
@item x
Execute actions on marked packages.
Execute actions on the marked packages.
@end table

A ``generation-list'' buffer additionally provides the following


@@ 244,6 249,7 @@ all) and faces.

@menu
* Guile and Build Options: emacs Build Options.	Specifying how packages are built.
* Buffer Names: emacs Buffer Names.	Names of Guix buffers.
* Keymaps: emacs Keymaps.		Configuring key bindings.
* Appearance: emacs Appearance.		Settings for visual appearance.
@end menu


@@ 270,6 276,39 @@ build}).

@end table

@node emacs Buffer Names
@subsubsection Buffer Names

Default names of ``guix.el'' buffers (``*Guix@tie{}@dots{}*'') may be
changed with the following variables:

@table @code
@item guix-package-list-buffer-name
@item guix-output-list-buffer-name
@item guix-generation-list-buffer-name
@item guix-package-info-buffer-name
@item guix-output-info-buffer-name
@item guix-generation-info-buffer-name
@item guix-repl-buffer-name
@item guix-internal-repl-buffer-name
@item guix-temp-buffer-name
@end table

For example if you want to display all types of results in a single
buffer (in such case you will probably use a history (@kbd{l}/@kbd{r})
extensively), you may do it like this:

@example
(let ((name "Guix Universal"))
  (setq
   guix-package-list-buffer-name    name
   guix-output-list-buffer-name     name
   guix-generation-list-buffer-name name
   guix-package-info-buffer-name    name
   guix-output-info-buffer-name     name
   guix-generation-info-buffer-name name))
@end example

@node emacs Keymaps
@subsubsection Keymaps



@@ 283,6 322,9 @@ Parent keymap with general keys for ``list'' buffers.
@item guix-package-list-mode-map
Keymap with specific keys for ``package-list'' buffers.

@item guix-output-list-mode-map
Keymap with specific keys for ``output-list'' buffers.

@item guix-generation-list-mode-map
Keymap with specific keys for ``generation-list'' buffers.



@@ 292,6 334,9 @@ Parent keymap with general keys for ``info'' buffers.
@item guix-package-info-mode-map
Keymap with specific keys for ``package-info'' buffers.

@item guix-output-info-mode-map
Keymap with specific keys for ``output-info'' buffers.

@item guix-generation-info-mode-map
Keymap with specific keys for ``generation-info'' buffers.


M emacs/guix-base.el => emacs/guix-base.el +65 -4
@@ 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.")

M emacs/guix-info.el => emacs/guix-info.el +51 -3
@@ 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

M emacs/guix-list.el => emacs/guix-list.el +155 -21
@@ 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)

M emacs/guix.el => emacs/guix.el +6 -6
@@ 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)