[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
30/37: emacs: Reorganize package/generation UI code.
|
From: |
Alex Kost |
|
Subject: |
30/37: emacs: Reorganize package/generation UI code. |
|
Date: |
Fri, 18 Dec 2015 18:51:33 +0000 |
alezost pushed a commit to branch wip-refactor-emacs-ui
in repository guix.
commit ee99158d0d6e0748bfd14dcdd9625dd8bc11e9b0
Author: Alex Kost <address@hidden>
Date: Wed Dec 9 14:44:34 2015 +0300
emacs: Reorganize package/generation UI code.
Move the code for packages/generations interface from "guix-info.el",
"guix-list.el", "guix-base.el" and "guix.el" to "guix-ui-package.el" and
"guix-ui-generation.el".
* emacs/guix-base.el (guix-package-entry->name-specification)
(guix-package-entries->name-specifications)
(guix-package-id-and-output-by-output-id)
(guix-package-installed-outputs, guix-process-package-actions)
(guix-package-list-type, guix-package-info-type)
(guix-continue-package-operation-p, guix-get-package-strings)
(guix-insert-package-strings): Move to "guix-ui-package.el".
(guix-generation-packages-buffer-name-function, guix-output-name-width)
(guix-generation-packages-update-buffer, guix-generation-packages)
(guix-generation-packages-buffer-name-default)
(guix-generation-packages-buffer-name-long)
(guix-generation-packages-buffer-name, guix-generation-packages-buffer)
(guix-generation-insert-packages, guix-generation-insert-package)
(guix-profile-generation-manifest-file, guix-delete-generations)
(guix-profile-generation-packages-buffer, guix-switch-to-generation):
Move to "guix-ui-generation.el".
* emacs/guix-info.el (guix-package-location, guix-package-name)
(guix-package-source, guix-package-info-source)
(guix-package-info-heading, guix-package-info-license)
(guix-package-info-name, guix-package-info-name-button)
(guix-package-info-version, guix-package-info-location)
(guix-package-info-synopsis, guix-package-info-description)
(guix-package-info-obsolete, guix-package-info-installed-outputs)
(guix-package-info-uninstalled-outputs)
(guix-package-info-insert-heading)
(guix-package-info-define-insert-inputs)
(guix-package-info-obsolete-string)
(guix-package-info-insert-obsolete-text)
(guix-package-info-insert-non-unique-text)
(guix-package-info-insert-outputs, guix-package-info-insert-output)
(guix-package-info-insert-action-button)
(guix-package-info-auto-find-source)
(guix-package-info-auto-download-source)
(guix-package-info-download-buffer, guix-package-info-show-source)
(guix-package-info-download-source, guix-package-info-insert-source)
(guix-package-info-redisplay-after-download)
(guix-output-info-insert-version, guix-output-info-insert-output):
Move to "guix-ui-package.el".
(guix-generation-info-number, guix-generation-info-current)
(guix-generation-not-current, guix-generation-info-insert-number)
(guix-generation-info-insert-current): Move to "guix-ui-generation.el".
* emacs/guix-list.el (guix-package-list-generation-marking-enabled)
(guix-package-list-installed, guix-package-list-obsolete)
(guix-package-list-get-name, guix-package-list-get-installed-outputs)
(guix-package-list-marking-check, guix-package-list-mark-outputs)
(guix-package-list-mark-install, guix-package-list-mark-delete)
(guix-package-list-mark-upgrade, guix-package-list-mark-upgrades)
(guix-list-mark-package-upgrades, guix-list-execute-package-actions)
(guix-package-list-execute, guix-package-list-make-action)
(guix-package-list-edit, guix-output-list-mark-install)
(guix-output-list-mark-delete, guix-output-list-mark-upgrade)
(guix-output-list-mark-upgrades, guix-output-list-make-action)
(guix-output-list-describe, guix-output-list-edit): Move to
"guix-ui-package.el".
(guix-generation-list-get-current, guix-generation-list-switch)
(guix-generation-list-generations-to-compare)
(guix-generation-list-compare, guix-generation-list-show-packages)
(guix-generation-list-show-added-packages)
(guix-generation-list-show-removed-packages)
(guix-generation-list-diff, guix-generation-list-diff-manifests)
(guix-generation-list-ediff, guix-generation-list-ediff-manifests)
(guix-generation-list-diff-packages)
(guix-generation-list-ediff-packages)
(guix-generation-list-mark-delete, guix-generation-list-execute): Move
to "guix-ui-generation.el".
* emacs/guix.el: Remove.
(guix, guix-faces, guix-edit): Move to "guix-base.el".
(guix-list-single-package, guix-search-params, guix-search-history)
(guix-get-show-packages, guix-search-by-name, guix-search-by-regexp)
(guix-installed-packages, guix-obsolete-packages)
(guix-all-available-packages, guix-newest-available-packages): Move
to "guix-ui-package.el".
(guix-get-show-generations, guix-generations, guix-last-generations)
(guix-generations-by-time): Move to "guix-ui-generation.el".
* emacs.am (ELFILES): Remove "guix.el". Add "guix-ui-package.el" and
"guix-ui-generation.el".
* doc/emacs.texi (Emacs Appearance): Adjust accordingly.
---
doc/emacs.texi | 2 +-
emacs.am | 5 +-
emacs/guix-base.el | 293 +------------
emacs/guix-info.el | 457 +--------------------
emacs/guix-list.el | 449 +--------------------
emacs/guix-ui-generation.el | 439 ++++++++++++++++++++
emacs/guix-ui-package.el | 960 +++++++++++++++++++++++++++++++++++++++++++
emacs/guix.el | 210 ----------
8 files changed, 1430 insertions(+), 1385 deletions(-)
diff --git a/doc/emacs.texi b/doc/emacs.texi
index ff86694..6b989a9 100644
--- a/doc/emacs.texi
+++ b/doc/emacs.texi
@@ -160,7 +160,7 @@ Display package(s) with the specified name.
@item M-x guix-search-by-regexp
Search for packages by a specified regexp. By default ``name'',
``synopsis'' and ``description'' of the packages will be searched. This
-can be changed by modifying @code{guix-search-params} variable.
+can be changed by modifying @code{guix-package-search-params} variable.
@end table
diff --git a/emacs.am b/emacs.am
index 7848b1c..bfd9494 100644
--- a/emacs.am
+++ b/emacs.am
@@ -42,8 +42,9 @@ ELFILES = \
emacs/guix-profiles.el \
emacs/guix-read.el \
emacs/guix-ui.el \
- emacs/guix-utils.el \
- emacs/guix.el
+ emacs/guix-ui-package.el \
+ emacs/guix-ui-generation.el \
+ emacs/guix-utils.el
if HAVE_EMACS
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index ab8acdf..dae658e 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -25,50 +25,29 @@
;;; Code:
(require 'cl-lib)
-(require 'guix-profiles)
(require 'guix-backend)
-(require 'guix-entry)
(require 'guix-guile)
+(require 'guix-read)
(require 'guix-utils)
(require 'guix-ui)
-
-;;; Parameters of the entries
+(defgroup guix nil
+ "Settings for Guix package manager and friends."
+ :prefix "guix-"
+ :group 'external)
+
+(defgroup guix-faces nil
+ "Guix faces."
+ :group 'guix
+ :group 'faces)
(defun guix-package-name-specification (name version &optional output)
"Return Guix package specification by its NAME, VERSION and OUTPUT."
(concat name "-" version
(when output (concat ":" output))))
-(defun guix-package-entry->name-specification (entry &optional output)
- "Return name specification of the package ENTRY and OUTPUT."
- (guix-package-name-specification
- (guix-entry-value entry 'name)
- (guix-entry-value entry 'version)
- (or output (guix-entry-value entry 'output))))
-
-(defun guix-package-entries->name-specifications (entries)
- "Return name specifications by the package or output ENTRIES."
- (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification
- entries)
- :test #'string=))
-
-(defun guix-package-installed-outputs (entry)
- "Return list of installed outputs for the package ENTRY."
- (mapcar (lambda (installed-entry)
- (guix-entry-value installed-entry 'output))
- (guix-entry-value entry 'installed)))
-
-(defun guix-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
+;;; Location of packages, profiles and manifests
(defvar guix-directory nil
"Default Guix directory.
@@ -108,56 +87,6 @@ For the meaning of location, see `guix-find-location'."
(guix-eval-read (guix-make-guile-expression
'package-location-string id-or-name)))
-
-;;; Getting and displaying info about packages and generations
-
-(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)
-
-(defcustom guix-package-info-type 'package
- "Define how to display packages in an info buffer.
-May be a symbol `package' or `output' (if `output', display each
-output separately; if `package', display outputs inside a package
-information)."
- :type '(choice (const :tag "Display packages" package)
- (const :tag "Display outputs" output))
- :group 'guix)
-
-
-;;; Generations
-
-(defcustom guix-generation-packages-buffer-name-function
- #'guix-generation-packages-buffer-name-default
- "Function used to define name of a buffer with generation packages.
-This function is called with 2 arguments: PROFILE (string) and
-GENERATION (number)."
- :type '(choice (function-item guix-generation-packages-buffer-name-default)
- (function-item guix-generation-packages-buffer-name-long)
- (function :tag "Other function"))
- :group 'guix)
-
-(defcustom guix-generation-packages-update-buffer t
- "If non-nil, always update list of packages during comparing generations.
-If nil, generation packages are received only once. So when you
-compare generation 1 and generation 2, the packages for both
-generations will be received. Then if you compare generation 1
-and generation 3, only the packages for generation 3 will be
-received. Thus if you use comparing of different generations a
-lot, you may set this variable to nil to improve the
-performance."
- :type 'boolean
- :group 'guix)
-
-(defvar guix-output-name-width 30
- "Width of an output name \"column\".
-This variable is used in auxiliary buffers for comparing generations.")
-
(defun guix-generation-file (profile generation)
"Return the file name of a PROFILE's GENERATION."
(format "%s-%s-link" profile generation))
@@ -171,75 +100,14 @@ this generation."
(guix-generation-file profile generation)
profile)))
-(defun guix-generation-packages (profile generation)
- "Return a list of sorted packages installed in PROFILE's GENERATION.
-Each element of the list is a list of the package specification and its path."
- (let ((names+paths (guix-eval-read
- (guix-make-guile-expression
- 'generation-package-specifications+paths
- profile generation))))
- (sort names+paths
- (lambda (a b)
- (string< (car a) (car b))))))
-
-(defun guix-generation-packages-buffer-name-default (profile generation)
- "Return name of a buffer for displaying GENERATION's package outputs.
-Use base name of PROFILE path."
- (let ((profile-name (file-name-base (directory-file-name profile))))
- (format "*Guix %s: generation %s*"
- profile-name generation)))
-
-(defun guix-generation-packages-buffer-name-long (profile generation)
- "Return name of a buffer for displaying GENERATION's package outputs.
-Use the full PROFILE path."
- (format "*Guix generation %s (%s)*"
- generation profile))
-
-(defun guix-generation-packages-buffer-name (profile generation)
- "Return name of a buffer for displaying GENERATION's package outputs."
- (let ((fun (if (functionp guix-generation-packages-buffer-name-function)
- guix-generation-packages-buffer-name-function
- #'guix-generation-packages-buffer-name-default)))
- (funcall fun profile generation)))
-
-(defun guix-generation-insert-package (name path)
- "Insert package output NAME and PATH at point."
- (insert name)
- (indent-to guix-output-name-width 2)
- (insert path "\n"))
-
-(defun guix-generation-insert-packages (buffer profile generation)
- "Insert package outputs installed in PROFILE's GENERATION in BUFFER."
- (with-current-buffer buffer
- (setq buffer-read-only nil
- indent-tabs-mode nil)
- (erase-buffer)
- (mapc (lambda (name+path)
- (guix-generation-insert-package
- (car name+path) (cadr name+path)))
- (guix-generation-packages profile generation))))
-
-(defun guix-generation-packages-buffer (profile generation)
- "Return buffer with package outputs installed in PROFILE's GENERATION.
-Create the buffer if needed."
- (let ((buf-name (guix-generation-packages-buffer-name
- profile generation)))
- (or (and (null guix-generation-packages-update-buffer)
- (get-buffer buf-name))
- (let ((buf (get-buffer-create buf-name)))
- (guix-generation-insert-packages buf profile generation)
- buf))))
-
-(defun guix-profile-generation-manifest-file (generation)
- "Return the file name of a GENERATION's manifest.
-GENERATION is a generation number of the current profile."
- (guix-manifest-file (guix-ui-current-profile) generation))
-
-(defun guix-profile-generation-packages-buffer (generation)
- "Insert GENERATION's package outputs in a buffer and return it.
-GENERATION is a generation number of the current profile."
- (guix-generation-packages-buffer (guix-ui-current-profile)
- generation))
+;;;###autoload
+(defun guix-edit (id-or-name)
+ "Edit (go to location of) package with ID-OR-NAME."
+ (interactive (list (guix-read-package-name)))
+ (let ((loc (guix-package-location id-or-name)))
+ (if loc
+ (guix-find-location loc)
+ (message "Couldn't find package location."))))
;;; Actions on packages and generations
@@ -313,101 +181,6 @@ VARIABLE is a name of an option variable.")
guix-operation-option-true-string
guix-operation-option-false-string))
-(defun guix-process-package-actions (profile actions
- &optional operation-buffer)
- "Process package ACTIONS on PROFILE.
-Each action is a list of the form:
-
- (ACTION-TYPE PACKAGE-SPEC ...)
-
-ACTION-TYPE is one of the following symbols: `install',
-`upgrade', `remove'/`delete'.
-PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
- (let (install upgrade remove)
- (mapc (lambda (action)
- (let ((action-type (car action))
- (specs (cdr action)))
- (cl-case action-type
- (install (setq install (append install specs)))
- (upgrade (setq upgrade (append upgrade specs)))
- ((remove delete) (setq remove (append remove specs))))))
- actions)
- (when (guix-continue-package-operation-p
- profile
- :install install :upgrade upgrade :remove remove)
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'process-package-actions profile
- :install install :upgrade upgrade :remove remove
- :use-substitutes? (or guix-use-substitutes 'f)
- :dry-run? (or guix-dry-run 'f))
- (and (not guix-dry-run) operation-buffer)))))
-
-(cl-defun guix-continue-package-operation-p (profile
- &key install upgrade remove)
- "Return non-nil if a package operation should be continued.
-Ask a user if needed (see `guix-operation-confirm').
-INSTALL, UPGRADE, REMOVE are 'package action specifications'.
-See `guix-process-package-actions' for details."
- (or (null guix-operation-confirm)
- (let* ((entries (guix-ui-get-entries
- profile 'package 'id
- (append (mapcar #'car install)
- (mapcar #'car upgrade)
- (mapcar #'car remove))
- '(id name version location)))
- (install-strings (guix-get-package-strings install entries))
- (upgrade-strings (guix-get-package-strings upgrade entries))
- (remove-strings (guix-get-package-strings remove entries)))
- (if (or install-strings upgrade-strings remove-strings)
- (let ((buf (get-buffer-create guix-temp-buffer-name)))
- (with-current-buffer buf
- (setq-local cursor-type nil)
- (setq buffer-read-only nil)
- (erase-buffer)
- (insert "Profile: " profile "\n\n")
- (guix-insert-package-strings install-strings "install")
- (guix-insert-package-strings upgrade-strings "upgrade")
- (guix-insert-package-strings remove-strings "remove")
- (let ((win (temp-buffer-window-show
- buf
- '((display-buffer-reuse-window
- display-buffer-at-bottom)
- (window-height . fit-window-to-buffer)))))
- (prog1 (guix-operation-prompt)
- (quit-window nil win)))))
- (message "Nothing to be done. If the REPL was restarted,
information is not up-to-date.")
- nil))))
-
-(defun guix-get-package-strings (specs entries)
- "Return short package descriptions for performing package actions.
-See `guix-process-package-actions' for the meaning of SPECS.
-ENTRIES is a list of package entries to get info about packages."
- (delq nil
- (mapcar
- (lambda (spec)
- (let* ((id (car spec))
- (outputs (cdr spec))
- (entry (guix-entry-by-id id entries)))
- (when entry
- (let ((location (guix-entry-value entry 'location)))
- (concat (guix-package-entry->name-specification entry)
- (when outputs
- (concat ":"
- (guix-concat-strings outputs ",")))
- (when location
- (concat "\t(" location ")")))))))
- specs)))
-
-(defun guix-insert-package-strings (strings action)
- "Insert information STRINGS at point for performing package ACTION."
- (when strings
- (insert "Package(s) to " (propertize action 'face 'bold) ":\n")
- (mapc (lambda (str)
- (insert " " str "\n"))
- strings)
- (insert "\n")))
-
(defun guix-operation-prompt (&optional prompt)
"Prompt a user for continuing the current operation.
Return non-nil, if the operation should be continued; nil otherwise.
@@ -462,34 +235,6 @@ Ask a user with PROMPT for continuing an operation."
guix-operation-option-separator)))
(force-mode-line-update))
-(defun guix-delete-generations (profile generations
- &optional operation-buffer)
- "Delete GENERATIONS from PROFILE.
-Each element from GENERATIONS is a generation number."
- (when (or (not guix-operation-confirm)
- (y-or-n-p
- (let ((count (length generations)))
- (if (> count 1)
- (format "Delete %d generations from profile '%s'? "
- count profile)
- (format "Delete generation %d from profile '%s'? "
- (car generations) profile)))))
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'delete-generations* profile generations)
- operation-buffer)))
-
-(defun guix-switch-to-generation (profile generation
- &optional operation-buffer)
- "Switch PROFILE to GENERATION."
- (when (or (not guix-operation-confirm)
- (y-or-n-p (format "Switch profile '%s' to generation %d? "
- profile generation)))
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'switch-to-generation* profile generation)
- operation-buffer)))
-
(defun guix-package-source-path (package-id)
"Return a store file path to a source of a package PACKAGE-ID."
(message "Calculating the source derivation ...")
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index f8ef921..66e3873 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -1,4 +1,4 @@
-;;; guix-info.el --- Info buffers for displaying entries -*-
lexical-binding: t -*-
+;;; guix-info.el --- 'Info' buffer interface for displaying data -*-
lexical-binding: t -*-
;; Copyright © 2014, 2015 Alex Kost <address@hidden>
;; Copyright © 2015 Ludovic Courtès <address@hidden>
@@ -20,15 +20,14 @@
;;; Commentary:
-;; This file provides a help-like buffer for displaying information
-;; about Guix packages and generations.
+;; This file provides 'info' (help-like) buffer interface for displaying
+;; an arbitrary data.
;;; Code:
-(require 'guix-base)
+(require 'guix-buffer)
(require 'guix-entry)
(require 'guix-utils)
-(require 'guix-ui)
(defgroup guix-info nil
"General settings for info buffers."
@@ -353,24 +352,6 @@ inserted line(s) with this face."
'action (lambda (btn)
(browse-url (button-label btn))))
-(define-button-type 'guix-package-location
- :supertype 'guix
- 'face 'guix-package-info-location
- 'help-echo "Find location of this package"
- 'action (lambda (btn)
- (guix-find-location (button-label btn))))
-
-(define-button-type 'guix-package-name
- :supertype 'guix
- 'face 'guix-package-info-name-button
- 'help-echo "Describe this package"
- 'action (lambda (btn)
- (guix-buffer-get-display-entries-current
- 'info guix-package-info-type
- (list (guix-ui-current-profile)
- 'name (button-label btn))
- 'add)))
-
(defun guix-info-button-copy-label (&optional pos)
"Copy a label of the button at POS into kill ring.
If POS is nil, use the current point position."
@@ -491,436 +472,6 @@ Print '%s' ENTRIES in the current 'info' buffer."
,@%foreign-args))))))))
-;;; Displaying packages
-
-(guix-ui-info-define-interface package
- :buffer-name "*Guix Package Info*"
- :format '(guix-package-info-insert-heading
- ignore
- (synopsis ignore (simple guix-package-info-synopsis))
- ignore
- (description ignore (simple guix-package-info-description))
- ignore
- (outputs simple guix-package-info-insert-outputs)
- (source simple guix-package-info-insert-source)
- (location format (format guix-package-location))
- (home-url format (format guix-url))
- (license format (format guix-package-info-license))
- (inputs format (format guix-package-input))
- (native-inputs
- format (format guix-package-native-input))
- (propagated-inputs
- format (format guix-package-propagated-input)))
- :titles '((home-url . "Home page"))
- :required '(id name version installed non-unique))
-
-(guix-info-define-interface installed-output
- :format '((path simple (indent guix-file))
- (dependencies simple (indent guix-file)))
- :titles '((path . "Store directory"))
- :reduced? t)
-
-(defface guix-package-info-heading
- '((t :inherit guix-info-heading))
- "Face for package name and version headings."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-name
- '((t :inherit font-lock-keyword-face))
- "Face used for a name of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-name-button
- '((t :inherit button))
- "Face used for a full name that can be used to describe a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-version
- '((t :inherit font-lock-builtin-face))
- "Face used for a version of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-synopsis
- '((((type tty pc) (class color)) :weight bold)
- (t :height 1.1 :weight bold :inherit variable-pitch))
- "Face used for a synopsis of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-description
- '((t))
- "Face used for a description of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-license
- '((t :inherit font-lock-string-face))
- "Face used for a license of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-location
- '((t :inherit link))
- "Face used for a location of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-installed-outputs
- '((default :weight bold)
- (((class color) (min-colors 88) (background light))
- :foreground "ForestGreen")
- (((class color) (min-colors 88) (background dark))
- :foreground "PaleGreen")
- (((class color) (min-colors 8))
- :foreground "green")
- (t :underline t))
- "Face used for installed outputs of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-uninstalled-outputs
- '((t :weight bold))
- "Face used for uninstalled outputs of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-obsolete
- '((t :inherit error))
- "Face used if a package is obsolete."
- :group 'guix-package-info-faces)
-
-(defun guix-package-info-insert-heading (entry)
- "Insert package ENTRY heading (name specification) at point."
- (guix-insert-button
- (guix-package-entry->name-specification entry)
- 'guix-package-name
- 'face 'guix-package-info-heading))
-
-(defmacro guix-package-info-define-insert-inputs (&optional type)
- "Define a face and a function for inserting package inputs.
-TYPE is a type of inputs.
-Function name is `guix-package-info-insert-TYPE-inputs'.
-Face name is `guix-package-info-TYPE-inputs'."
- (let* ((type-str (symbol-name type))
- (type-name (and type (concat type-str "-")))
- (type-desc (and type (concat type-str " ")))
- (face (intern (concat "guix-package-info-" type-name "inputs")))
- (btn (intern (concat "guix-package-" type-name "input"))))
- `(progn
- (defface ,face
- '((t :inherit guix-package-info-name-button))
- ,(concat "Face used for " type-desc "inputs of a package.")
- :group 'guix-package-info-faces)
-
- (define-button-type ',btn
- :supertype 'guix-package-name
- 'face ',face))))
-
-(guix-package-info-define-insert-inputs)
-(guix-package-info-define-insert-inputs native)
-(guix-package-info-define-insert-inputs propagated)
-
-
-;;; Inserting outputs and installed parameters
-
-(defvar guix-package-info-output-format "%-10s"
- "String used to format output names of the packages.
-It should be a '%s'-sequence. After inserting an output name
-formatted with this string, an action button is inserted.")
-
-(defvar guix-package-info-obsolete-string "(This package is obsolete)"
- "String used if a package is obsolete.")
-
-(defun guix-package-info-insert-outputs (outputs entry)
- "Insert OUTPUTS from package ENTRY at point."
- (and (guix-entry-value entry 'obsolete)
- (guix-package-info-insert-obsolete-text))
- (and (guix-entry-value entry 'non-unique)
- (guix-entry-value entry 'installed)
- (guix-package-info-insert-non-unique-text
- (guix-package-entry->name-specification entry)))
- (insert "\n")
- (mapc (lambda (output)
- (guix-package-info-insert-output output entry))
- outputs))
-
-(defun guix-package-info-insert-obsolete-text ()
- "Insert a message about obsolete package at point."
- (guix-info-insert-indent)
- (guix-format-insert guix-package-info-obsolete-string
- 'guix-package-info-obsolete))
-
-(defun guix-package-info-insert-non-unique-text (full-name)
- "Insert a message about non-unique package with FULL-NAME at point."
- (insert "\n")
- (guix-info-insert-indent)
- (insert "Installed outputs are displayed for a non-unique ")
- (guix-insert-button full-name 'guix-package-name)
- (insert " package."))
-
-(defun guix-package-info-insert-output (output entry)
- "Insert OUTPUT at point.
-Make some fancy text with buttons and additional stuff if the
-current OUTPUT is installed (if there is such output in
-`installed' parameter of a package ENTRY)."
- (let* ((installed (guix-entry-value entry 'installed))
- (obsolete (guix-entry-value entry 'obsolete))
- (installed-entry (cl-find-if
- (lambda (entry)
- (string= (guix-entry-value entry 'output)
- output))
- installed))
- (action-type (if installed-entry 'delete 'install)))
- (guix-info-insert-indent)
- (guix-format-insert output
- (if installed-entry
- 'guix-package-info-installed-outputs
- 'guix-package-info-uninstalled-outputs)
- guix-package-info-output-format)
- (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))
- (insert "\n")
- (when installed-entry
- (guix-info-insert-entry installed-entry 'installed-output 2))))
-
-(defun guix-package-info-insert-action-button (type entry output)
- "Insert button to process an action on a package OUTPUT at point.
-TYPE is one of the following symbols: `install', `delete', `upgrade'.
-ENTRY is an alist with package info."
- (let ((type-str (capitalize (symbol-name type)))
- (full-name (guix-package-entry->name-specification entry output)))
- (guix-info-insert-action-button
- type-str
- (lambda (btn)
- (guix-process-package-actions
- (guix-ui-current-profile)
- `((,(button-get btn 'action-type) (,(button-get btn 'id)
- ,(button-get btn 'output))))
- (current-buffer)))
- (concat type-str " '" full-name "'")
- 'action-type type
- 'id (or (guix-entry-value entry 'package-id)
- (guix-entry-id entry))
- 'output output)))
-
-
-;;; Inserting a source
-
-(defface guix-package-info-source
- '((t :inherit link :underline nil))
- "Face used for a source URL of a package."
- :group 'guix-package-info-faces)
-
-(defcustom guix-package-info-auto-find-source nil
- "If non-nil, find a source file after pressing a \"Show\" button.
-If nil, just display the source file path without finding."
- :type 'boolean
- :group 'guix-package-info)
-
-(defcustom guix-package-info-auto-download-source t
- "If nil, do not automatically download a source file if it doesn't exist.
-After pressing a \"Show\" button, a derivation of the package
-source is calculated and a store file path is displayed. If this
-variable is non-nil and the source file does not exist in the
-store, it will be automatically downloaded (with a possible
-prompt depending on `guix-operation-confirm' variable)."
- :type 'boolean
- :group 'guix-package-info)
-
-(defvar guix-package-info-download-buffer nil
- "Buffer from which a current download operation was performed.")
-
-(define-button-type 'guix-package-source
- :supertype 'guix
- 'face 'guix-package-info-source
- 'help-echo ""
- 'action (lambda (_)
- ;; As a source may not be a real URL (e.g., "mirror://..."),
- ;; no action is bound to a source button.
- (message "Yes, this is the source URL. What did you expect?")))
-
-(defun guix-package-info-show-source (entry-id package-id)
- "Show file name of a package source in the current info buffer.
-Find the file if needed (see `guix-package-info-auto-find-source').
-ENTRY-ID is an ID of the current entry (package or output).
-PACKAGE-ID is an ID of the package which source to show."
- (let* ((entries (guix-buffer-current-entries))
- (entry (guix-entry-by-id entry-id entries))
- (file (guix-package-source-path package-id)))
- (or file
- (error "Couldn't define file name of the package source"))
- (let* ((new-entry (cons (cons 'source-file file)
- entry))
- (new-entries (guix-replace-entry entry-id new-entry entries)))
- (setf (guix-buffer-item-entries guix-buffer-item)
- new-entries)
- (guix-buffer-redisplay-goto-button)
- (if (file-exists-p file)
- (if guix-package-info-auto-find-source
- (guix-find-file file)
- (message "The source store path is displayed."))
- (if guix-package-info-auto-download-source
- (guix-package-info-download-source package-id)
- (message "The source does not exist in the store."))))))
-
-(defun guix-package-info-download-source (package-id)
- "Download a source of the package PACKAGE-ID."
- (setq guix-package-info-download-buffer (current-buffer))
- (guix-package-source-build-derivation
- package-id
- "The source does not exist in the store. Download it?"))
-
-(defun guix-package-info-insert-source (source entry)
- "Insert SOURCE from package ENTRY at point.
-SOURCE is a list of URLs."
- (if (null source)
- (guix-format-insert nil)
- (let* ((source-file (guix-entry-value entry 'source-file))
- (entry-id (guix-entry-id entry))
- (package-id (or (guix-entry-value entry 'package-id)
- entry-id)))
- (if (null source-file)
- (guix-info-insert-action-button
- "Show"
- (lambda (btn)
- (guix-package-info-show-source (button-get btn 'entry-id)
- (button-get btn 'package-id)))
- "Show the source store directory of the current package"
- 'entry-id entry-id
- 'package-id package-id)
- (unless (file-exists-p source-file)
- (guix-info-insert-action-button
- "Download"
- (lambda (btn)
- (guix-package-info-download-source
- (button-get btn 'package-id)))
- "Download the source into the store"
- 'package-id package-id))
- (guix-info-insert-value-indent source-file 'guix-file))
- (guix-info-insert-value-indent source 'guix-package-source))))
-
-(defun guix-package-info-redisplay-after-download ()
- "Redisplay an 'info' buffer after downloading the package source.
-This function is used to hide a \"Download\" button if needed."
- (when (buffer-live-p guix-package-info-download-buffer)
- (with-current-buffer guix-package-info-download-buffer
- (guix-buffer-redisplay-goto-button))
- (setq guix-package-info-download-buffer nil)))
-
-(add-hook 'guix-after-source-download-hook
- 'guix-package-info-redisplay-after-download)
-
-
-;;; Displaying outputs
-
-(guix-ui-info-define-interface output
- :buffer-name "*Guix Package Info*"
- :format '((name format (format guix-package-info-name))
- (version format guix-output-info-insert-version)
- (output format guix-output-info-insert-output)
- (synopsis format (format guix-package-info-synopsis))
- (source simple guix-package-info-insert-source)
- (path simple (indent guix-file))
- (dependencies simple (indent guix-file))
- (location format (format guix-package-location))
- (home-url format (format guix-url))
- (license format (format guix-package-info-license))
- (inputs format (format guix-package-input))
- (native-inputs
- format (format guix-package-native-input))
- (propagated-inputs
- format (format guix-package-propagated-input))
- (description format (format guix-package-info-description)))
- :titles '((home-url . "Home page"))
- :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-value-format version
- 'guix-package-info-version)
- (and (guix-entry-value 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-entry-value entry 'installed))
- (obsolete (guix-entry-value entry 'obsolete))
- (action-type (if installed 'delete 'install)))
- (guix-info-insert-value-format
- 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
-
-(guix-ui-info-define-interface generation
- :buffer-name "*Guix Generation Info*"
- :format '((number format guix-generation-info-insert-number)
- (prev-number format (format))
- (current format guix-generation-info-insert-current)
- (path simple (indent guix-file))
- (time format (time)))
- :titles '((path . "File name")
- (prev-number . "Previous number")))
-
-(defface guix-generation-info-number
- '((t :inherit font-lock-keyword-face))
- "Face used for a number of a generation."
- :group 'guix-generation-info-faces)
-
-(defface guix-generation-info-current
- '((t :inherit guix-package-info-installed-outputs))
- "Face used if a generation is the current one."
- :group 'guix-generation-info-faces)
-
-(defface guix-generation-info-not-current
- '((t nil))
- "Face used if a generation is not the current one."
- :group 'guix-generation-info-faces)
-
-(defun guix-generation-info-insert-number (number &optional _)
- "Insert generation NUMBER and action buttons."
- (guix-info-insert-value-format number 'guix-generation-info-number)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Packages"
- (lambda (btn)
- (guix-buffer-get-display-entries
- 'list guix-package-list-type
- (list (guix-ui-current-profile)
- 'generation (button-get btn 'number))
- 'add))
- "Show installed packages for this generation"
- 'number number)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Delete"
- (lambda (btn)
- (guix-delete-generations (guix-ui-current-profile)
- (list (button-get btn 'number))
- (current-buffer)))
- "Delete this generation"
- 'number number))
-
-(defun guix-generation-info-insert-current (val entry)
- "Insert boolean value VAL showing whether this generation is current."
- (if val
- (guix-info-insert-value-format "Yes" 'guix-generation-info-current)
- (guix-info-insert-value-format "No" 'guix-generation-info-not-current)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Switch"
- (lambda (btn)
- (guix-switch-to-generation (guix-ui-current-profile)
- (button-get btn 'number)
- (current-buffer)))
- "Switch to this generation (make it the current one)"
- 'number (guix-entry-value entry 'number))))
-
-
(defvar guix-info-font-lock-keywords
(eval-when-compile
`((,(rx "(" (group "guix-info-define-interface")
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index f5c5038..719642a 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -1,4 +1,4 @@
-;;; guix-list.el --- List buffers for displaying entries -*-
lexical-binding: t -*-
+;;; guix-list.el --- 'List' buffer interface for displaying data -*-
lexical-binding: t -*-
;; Copyright © 2014, 2015 Alex Kost <address@hidden>
@@ -19,18 +19,17 @@
;;; Commentary:
-;; This file provides a list-like buffer for displaying information
-;; about Guix packages and generations.
+;; This file provides 'list' buffer interface for displaying an arbitrary
+;; data.
;;; Code:
(require 'cl-lib)
(require 'tabulated-list)
+(require 'guix-buffer)
(require 'guix-info)
-(require 'guix-base)
(require 'guix-entry)
(require 'guix-utils)
-(require 'guix-ui)
(defgroup guix-list nil
"General settings for list buffers."
@@ -534,446 +533,6 @@ Set up the current 'list' buffer for displaying '%s'
entries."
,@%foreign-args))))))))
-;;; Displaying packages
-
-(guix-ui-list-define-interface package
- :buffer-name "*Guix Package List*"
- :format '((name guix-package-list-get-name 20 t)
- (version nil 10 nil)
- (outputs nil 13 t)
- (installed guix-package-list-get-installed-outputs 13 t)
- (synopsis guix-list-get-one-line 30 nil))
- :sort-key '(name)
- :marks '((install . ?I)
- (upgrade . ?U)
- (delete . ?D)))
-
-(defface guix-package-list-installed
- '((t :inherit guix-package-info-installed-outputs))
- "Face used if there are installed outputs for the current package."
- :group 'guix-package-list-faces)
-
-(defface guix-package-list-obsolete
- '((t :inherit guix-package-info-obsolete))
- "Face used if a package is obsolete."
- :group 'guix-package-list-faces)
-
-(defcustom guix-package-list-generation-marking-enabled nil
- "If non-nil, allow putting marks in a list with 'generation packages'.
-
-By default this is disabled, because it may be confusing. For
-example a package is installed in some generation, so a user can
-mark it for deletion in the list of packages from this
-generation, but the package may not be installed in the latest
-generation, so actually it cannot be deleted.
-
-If you managed to understand the explanation above or if you
-really know what you do or if you just don't care, you can set
-this variable to t. It should not do much harm anyway (most
-likely)."
- :type 'boolean
- :group 'guix-package-list)
-
-(let ((map guix-package-list-mode-map))
- (define-key map (kbd "e") 'guix-package-list-edit)
- (define-key map (kbd "x") 'guix-package-list-execute)
- (define-key map (kbd "i") 'guix-package-list-mark-install)
- (define-key map (kbd "d") 'guix-package-list-mark-delete)
- (define-key map (kbd "U") 'guix-package-list-mark-upgrade)
- (define-key map (kbd "^") 'guix-package-list-mark-upgrades))
-
-(defun guix-package-list-get-name (name entry)
- "Return NAME of the package ENTRY.
-Colorize it with `guix-package-list-installed' or
-`guix-package-list-obsolete' if needed."
- (guix-get-string name
- (cond ((guix-entry-value entry 'obsolete)
- 'guix-package-list-obsolete)
- ((guix-entry-value entry 'installed)
- 'guix-package-list-installed))))
-
-(defun guix-package-list-get-installed-outputs (installed &optional _)
- "Return string with outputs from INSTALLED entries."
- (guix-get-string
- (mapcar (lambda (entry)
- (guix-entry-value entry 'output))
- installed)))
-
-(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)
- (or (derived-mode-p 'guix-package-list-mode)
- (derived-mode-p 'guix-output-list-mode))
- (eq (guix-ui-current-search-type) 'generation))
- (error "Action marks are disabled for lists of 'generation packages'")))
-
-(defun guix-package-list-mark-outputs (mark default
- &optional prompt available)
- "Mark the current package with MARK and move to the next line.
-If PROMPT is non-nil, use it to ask a user for outputs from
-AVAILABLE list, otherwise mark all DEFAULT outputs."
- (let ((outputs (if prompt
- (guix-completing-read-multiple
- prompt available nil t)
- default)))
- (apply #'guix-list--mark mark t outputs)))
-
-(defun guix-package-list-mark-install (&optional arg)
- "Mark the current package for installation and move to the next line.
-With ARG, prompt for the outputs to install (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (all (guix-entry-value entry 'outputs))
- (installed (guix-package-installed-outputs entry))
- (available (cl-set-difference all installed :test #'string=)))
- (or available
- (user-error "This package is already installed"))
- (guix-package-list-mark-outputs
- 'install '("out")
- (and arg "Output(s) to install: ")
- available)))
-
-(defun guix-package-list-mark-delete (&optional arg)
- "Mark the current package for deletion and move to the next line.
-With ARG, prompt for the outputs to delete (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-package-installed-outputs entry)))
- (or installed
- (user-error "This package is not installed"))
- (guix-package-list-mark-outputs
- 'delete installed
- (and arg "Output(s) to delete: ")
- installed)))
-
-(defun guix-package-list-mark-upgrade (&optional arg)
- "Mark the current package for upgrading and move to the next line.
-With ARG, prompt for the outputs to upgrade (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-package-installed-outputs entry)))
- (or installed
- (user-error "This package is not installed"))
- (when (or (guix-entry-value entry 'obsolete)
- (y-or-n-p "This package is not obsolete. Try to upgrade it
anyway? "))
- (guix-package-list-mark-outputs
- 'upgrade installed
- (and arg "Output(s) to upgrade: ")
- installed))))
-
-(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)
- (guix-entry-value entry 'obsolete))
- (guix-buffer-current-entries))))
- (guix-list-for-each-line
- (lambda ()
- (let* ((id (guix-list-current-id))
- (entry (cl-find-if
- (lambda (entry)
- (equal id (guix-entry-id entry)))
- obsolete)))
- (when entry
- (funcall fun entry)))))))
-
-(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-package-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 fun '(install delete upgrade)))))
- (if actions
- (guix-process-package-actions (guix-ui-current-profile)
- actions (current-buffer))
- (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.
-The specification is suitable for `guix-process-package-actions'."
- (let ((specs (guix-list-get-marked-args action-type)))
- (and specs (cons action-type specs))))
-
-(defun guix-package-list-edit ()
- "Go to the location of the current package."
- (interactive)
- (guix-edit (guix-list-current-id)))
-
-
-;;; Displaying outputs
-
-(guix-ui-list-define-interface output
- :buffer-name "*Guix Package List*"
- :describe-function 'guix-output-list-describe
- :format '((name guix-package-list-get-name 20 t)
- (version nil 10 nil)
- (output nil 9 t)
- (installed nil 12 t)
- (synopsis guix-list-get-one-line 30 nil))
- :required '(id package-id)
- :sort-key '(name)
- :marks '((install . ?I)
- (upgrade . ?U)
- (delete . ?D)))
-
-(let ((map guix-output-list-mode-map))
- (define-key map (kbd "e") 'guix-output-list-edit)
- (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-entry-value 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-entry-value 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-entry-value entry 'installed)))
- (or installed
- (user-error "This output is not installed"))
- (when (or (guix-entry-value 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-package-id-and-output-by-output-id
- ids)))))
-
-(defun guix-output-list-describe (ids)
- "Describe outputs with IDS (list of output identifiers).
-See `guix-package-info-type'."
- (if (eq guix-package-info-type 'output)
- (guix-buffer-get-display-entries
- 'info 'output
- (cl-list* (guix-ui-current-profile) 'id ids)
- 'add)
- (let ((pids (mapcar (lambda (oid)
- (car (guix-package-id-and-output-by-output-id
- oid)))
- ids)))
- (guix-buffer-get-display-entries
- 'info 'package
- (cl-list* (guix-ui-current-profile)
- 'id (cl-remove-duplicates pids))
- 'add))))
-
-(defun guix-output-list-edit ()
- "Go to the location of the current package."
- (interactive)
- (guix-edit (guix-entry-value (guix-list-current-entry)
- 'package-id)))
-
-
-;;; Displaying generations
-
-(guix-ui-list-define-interface generation
- :buffer-name "*Guix Generation List*"
- :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
- (current guix-generation-list-get-current 10 t)
- (time guix-list-get-time 20 t)
- (path guix-list-get-file-path 30 t))
- :titles '((number . "N."))
- :sort-key '(number . t)
- :marks '((delete . ?D)))
-
-(let ((map guix-generation-list-mode-map))
- (define-key map (kbd "RET") 'guix-generation-list-show-packages)
- (define-key map (kbd "+") 'guix-generation-list-show-added-packages)
- (define-key map (kbd "-") 'guix-generation-list-show-removed-packages)
- (define-key map (kbd "=") 'guix-generation-list-diff)
- (define-key map (kbd "D") 'guix-generation-list-diff)
- (define-key map (kbd "e") 'guix-generation-list-ediff)
- (define-key map (kbd "x") 'guix-generation-list-execute)
- (define-key map (kbd "s") 'guix-generation-list-switch)
- (define-key map (kbd "d") 'guix-generation-list-mark-delete))
-
-(defun guix-generation-list-get-current (val &optional _)
- "Return string from VAL showing whether this generation is current.
-VAL is a boolean value."
- (if val "(current)" ""))
-
-(defun guix-generation-list-switch ()
- "Switch current profile to the generation at point."
- (interactive)
- (let* ((entry (guix-list-current-entry))
- (current (guix-entry-value entry 'current))
- (number (guix-entry-value entry 'number)))
- (if current
- (user-error "This generation is already the current one")
- (guix-switch-to-generation (guix-ui-current-profile)
- number (current-buffer)))))
-
-(defun guix-generation-list-show-packages ()
- "List installed packages for the generation at point."
- (interactive)
- (guix-get-show-packages
- (guix-ui-current-profile)
- 'generation (guix-list-current-id)))
-
-(defun guix-generation-list-generations-to-compare ()
- "Return a sorted list of 2 marked generations for comparing."
- (let ((numbers (guix-list-get-marked-id-list 'general)))
- (if (/= (length numbers) 2)
- (user-error "2 generations should be marked for comparing")
- (sort numbers #'<))))
-
-(defun guix-generation-list-show-added-packages ()
- "List package outputs added to the latest marked generation.
-If 2 generations are marked with \\[guix-list-mark], display
-outputs installed in the latest marked generation that were not
-installed in the other one."
- (interactive)
- (guix-buffer-get-display-entries
- 'list 'output
- (cl-list* (guix-ui-current-profile)
- 'generation-diff
- (reverse (guix-generation-list-generations-to-compare)))
- 'add))
-
-(defun guix-generation-list-show-removed-packages ()
- "List package outputs removed from the latest marked generation.
-If 2 generations are marked with \\[guix-list-mark], display
-outputs not installed in the latest marked generation that were
-installed in the other one."
- (interactive)
- (guix-buffer-get-display-entries
- 'list 'output
- (cl-list* (guix-ui-current-profile)
- 'generation-diff
- (guix-generation-list-generations-to-compare))
- 'add))
-
-(defun guix-generation-list-compare (diff-fun gen-fun)
- "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
- (cl-multiple-value-bind (gen1 gen2)
- (guix-generation-list-generations-to-compare)
- (funcall diff-fun
- (funcall gen-fun gen1)
- (funcall gen-fun gen2))))
-
-(defun guix-generation-list-ediff-manifests ()
- "Run Ediff on manifests of the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'ediff-files
- #'guix-profile-generation-manifest-file))
-
-(defun guix-generation-list-diff-manifests ()
- "Run Diff on manifests of the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'guix-diff
- #'guix-profile-generation-manifest-file))
-
-(defun guix-generation-list-ediff-packages ()
- "Run Ediff on package outputs installed in the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'ediff-buffers
- #'guix-profile-generation-packages-buffer))
-
-(defun guix-generation-list-diff-packages ()
- "Run Diff on package outputs installed in the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'guix-diff
- #'guix-profile-generation-packages-buffer))
-
-(defun guix-generation-list-ediff (arg)
- "Run Ediff on package outputs installed in the 2 marked generations.
-With ARG, run Ediff on manifests of the marked generations."
- (interactive "P")
- (if arg
- (guix-generation-list-ediff-manifests)
- (guix-generation-list-ediff-packages)))
-
-(defun guix-generation-list-diff (arg)
- "Run Diff on package outputs installed in the 2 marked generations.
-With ARG, run Diff on manifests of the marked generations."
- (interactive "P")
- (if arg
- (guix-generation-list-diff-manifests)
- (guix-generation-list-diff-packages)))
-
-(defun guix-generation-list-mark-delete (&optional arg)
- "Mark the current generation for deletion and move to the next line.
-With ARG, mark all generations for deletion."
- (interactive "P")
- (if arg
- (guix-list-mark-all 'delete)
- (guix-list--mark 'delete t)))
-
-(defun guix-generation-list-execute ()
- "Delete marked generations."
- (interactive)
- (let ((marked (guix-list-get-marked-id-list 'delete)))
- (or marked
- (user-error "No generations marked for deletion"))
- (guix-delete-generations (guix-ui-current-profile)
- marked (current-buffer))))
-
-
(defvar guix-list-font-lock-keywords
(eval-when-compile
`((,(rx "(" (group "guix-list-define-interface")
diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el
new file mode 100644
index 0000000..7d6762a
--- /dev/null
+++ b/emacs/guix-ui-generation.el
@@ -0,0 +1,439 @@
+;;; guix-ui-generation.el --- Interface for displaying generations -*-
lexical-binding: t -*-
+
+;; Copyright © 2014, 2015 Alex Kost <address@hidden>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides an interface for displaying profile generations in
+;; 'list' and 'info' buffers, and commands for working with them.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'guix-buffer)
+(require 'guix-list)
+(require 'guix-info)
+(require 'guix-ui)
+(require 'guix-ui-package)
+(require 'guix-base)
+(require 'guix-backend)
+(require 'guix-guile)
+(require 'guix-entry)
+(require 'guix-utils)
+
+(defgroup guix-generation nil
+ "Interface for displaying generations."
+ :group 'guix-ui)
+
+(defun guix-generation-get-display (profile search-type &rest search-values)
+ "Search for generations and show results.
+
+If PROFILE is nil, use `guix-current-profile'.
+
+See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
+SEARCH-VALUES."
+ (let ((args (cl-list* (or profile guix-current-profile)
+ search-type search-values)))
+ (guix-buffer-get-display-entries
+ 'list 'generation args 'add)))
+
+(defun guix-delete-generations (profile generations
+ &optional operation-buffer)
+ "Delete GENERATIONS from PROFILE.
+Each element from GENERATIONS is a generation number."
+ (when (or (not guix-operation-confirm)
+ (y-or-n-p
+ (let ((count (length generations)))
+ (if (> count 1)
+ (format "Delete %d generations from profile '%s'? "
+ count profile)
+ (format "Delete generation %d from profile '%s'? "
+ (car generations) profile)))))
+ (guix-eval-in-repl
+ (guix-make-guile-expression
+ 'delete-generations* profile generations)
+ operation-buffer)))
+
+(defun guix-switch-to-generation (profile generation
+ &optional operation-buffer)
+ "Switch PROFILE to GENERATION."
+ (when (or (not guix-operation-confirm)
+ (y-or-n-p (format "Switch profile '%s' to generation %d? "
+ profile generation)))
+ (guix-eval-in-repl
+ (guix-make-guile-expression
+ 'switch-to-generation* profile generation)
+ operation-buffer)))
+
+
+;;; Generation 'info'
+
+(guix-ui-info-define-interface generation
+ :buffer-name "*Guix Generation Info*"
+ :format '((number format guix-generation-info-insert-number)
+ (prev-number format (format))
+ (current format guix-generation-info-insert-current)
+ (path simple (indent guix-file))
+ (time format (time)))
+ :titles '((path . "File name")
+ (prev-number . "Previous number")))
+
+(defface guix-generation-info-number
+ '((t :inherit font-lock-keyword-face))
+ "Face used for a number of a generation."
+ :group 'guix-generation-info-faces)
+
+(defface guix-generation-info-current
+ '((t :inherit guix-package-info-installed-outputs))
+ "Face used if a generation is the current one."
+ :group 'guix-generation-info-faces)
+
+(defface guix-generation-info-not-current
+ '((t nil))
+ "Face used if a generation is not the current one."
+ :group 'guix-generation-info-faces)
+
+(defun guix-generation-info-insert-number (number &optional _)
+ "Insert generation NUMBER and action buttons."
+ (guix-info-insert-value-format number 'guix-generation-info-number)
+ (guix-info-insert-indent)
+ (guix-info-insert-action-button
+ "Packages"
+ (lambda (btn)
+ (guix-buffer-get-display-entries
+ 'list guix-package-list-type
+ (list (guix-ui-current-profile)
+ 'generation (button-get btn 'number))
+ 'add))
+ "Show installed packages for this generation"
+ 'number number)
+ (guix-info-insert-indent)
+ (guix-info-insert-action-button
+ "Delete"
+ (lambda (btn)
+ (guix-delete-generations (guix-ui-current-profile)
+ (list (button-get btn 'number))
+ (current-buffer)))
+ "Delete this generation"
+ 'number number))
+
+(defun guix-generation-info-insert-current (val entry)
+ "Insert boolean value VAL showing whether this generation is current."
+ (if val
+ (guix-info-insert-value-format "Yes" 'guix-generation-info-current)
+ (guix-info-insert-value-format "No" 'guix-generation-info-not-current)
+ (guix-info-insert-indent)
+ (guix-info-insert-action-button
+ "Switch"
+ (lambda (btn)
+ (guix-switch-to-generation (guix-ui-current-profile)
+ (button-get btn 'number)
+ (current-buffer)))
+ "Switch to this generation (make it the current one)"
+ 'number (guix-entry-value entry 'number))))
+
+
+;;; Generation 'list'
+
+(guix-ui-list-define-interface generation
+ :buffer-name "*Guix Generation List*"
+ :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
+ (current guix-generation-list-get-current 10 t)
+ (time guix-list-get-time 20 t)
+ (path guix-list-get-file-path 30 t))
+ :titles '((number . "N."))
+ :sort-key '(number . t)
+ :marks '((delete . ?D)))
+
+(let ((map guix-generation-list-mode-map))
+ (define-key map (kbd "RET") 'guix-generation-list-show-packages)
+ (define-key map (kbd "+") 'guix-generation-list-show-added-packages)
+ (define-key map (kbd "-") 'guix-generation-list-show-removed-packages)
+ (define-key map (kbd "=") 'guix-generation-list-diff)
+ (define-key map (kbd "D") 'guix-generation-list-diff)
+ (define-key map (kbd "e") 'guix-generation-list-ediff)
+ (define-key map (kbd "x") 'guix-generation-list-execute)
+ (define-key map (kbd "s") 'guix-generation-list-switch)
+ (define-key map (kbd "c") 'guix-generation-list-switch)
+ (define-key map (kbd "d") 'guix-generation-list-mark-delete))
+
+(defun guix-generation-list-get-current (val &optional _)
+ "Return string from VAL showing whether this generation is current.
+VAL is a boolean value."
+ (if val "(current)" ""))
+
+(defun guix-generation-list-switch ()
+ "Switch current profile to the generation at point."
+ (interactive)
+ (let* ((entry (guix-list-current-entry))
+ (current (guix-entry-value entry 'current))
+ (number (guix-entry-value entry 'number)))
+ (if current
+ (user-error "This generation is already the current one")
+ (guix-switch-to-generation (guix-ui-current-profile)
+ number (current-buffer)))))
+
+(defun guix-generation-list-show-packages ()
+ "List installed packages for the generation at point."
+ (interactive)
+ (guix-package-get-display
+ (guix-ui-current-profile)
+ 'generation (guix-list-current-id)))
+
+(defun guix-generation-list-generations-to-compare ()
+ "Return a sorted list of 2 marked generations for comparing."
+ (let ((numbers (guix-list-get-marked-id-list 'general)))
+ (if (/= (length numbers) 2)
+ (user-error "2 generations should be marked for comparing")
+ (sort numbers #'<))))
+
+(defun guix-generation-list-show-added-packages ()
+ "List package outputs added to the latest marked generation.
+If 2 generations are marked with \\[guix-list-mark], display
+outputs installed in the latest marked generation that were not
+installed in the other one."
+ (interactive)
+ (guix-buffer-get-display-entries
+ 'list 'output
+ (cl-list* (guix-ui-current-profile)
+ 'generation-diff
+ (reverse (guix-generation-list-generations-to-compare)))
+ 'add))
+
+(defun guix-generation-list-show-removed-packages ()
+ "List package outputs removed from the latest marked generation.
+If 2 generations are marked with \\[guix-list-mark], display
+outputs not installed in the latest marked generation that were
+installed in the other one."
+ (interactive)
+ (guix-buffer-get-display-entries
+ 'list 'output
+ (cl-list* (guix-ui-current-profile)
+ 'generation-diff
+ (guix-generation-list-generations-to-compare))
+ 'add))
+
+(defun guix-generation-list-compare (diff-fun gen-fun)
+ "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
+ (cl-multiple-value-bind (gen1 gen2)
+ (guix-generation-list-generations-to-compare)
+ (funcall diff-fun
+ (funcall gen-fun gen1)
+ (funcall gen-fun gen2))))
+
+(defun guix-generation-list-ediff-manifests ()
+ "Run Ediff on manifests of the 2 marked generations."
+ (interactive)
+ (guix-generation-list-compare
+ #'ediff-files
+ #'guix-profile-generation-manifest-file))
+
+(defun guix-generation-list-diff-manifests ()
+ "Run Diff on manifests of the 2 marked generations."
+ (interactive)
+ (guix-generation-list-compare
+ #'guix-diff
+ #'guix-profile-generation-manifest-file))
+
+(defun guix-generation-list-ediff-packages ()
+ "Run Ediff on package outputs installed in the 2 marked generations."
+ (interactive)
+ (guix-generation-list-compare
+ #'ediff-buffers
+ #'guix-profile-generation-packages-buffer))
+
+(defun guix-generation-list-diff-packages ()
+ "Run Diff on package outputs installed in the 2 marked generations."
+ (interactive)
+ (guix-generation-list-compare
+ #'guix-diff
+ #'guix-profile-generation-packages-buffer))
+
+(defun guix-generation-list-ediff (arg)
+ "Run Ediff on package outputs installed in the 2 marked generations.
+With ARG, run Ediff on manifests of the marked generations."
+ (interactive "P")
+ (if arg
+ (guix-generation-list-ediff-manifests)
+ (guix-generation-list-ediff-packages)))
+
+(defun guix-generation-list-diff (arg)
+ "Run Diff on package outputs installed in the 2 marked generations.
+With ARG, run Diff on manifests of the marked generations."
+ (interactive "P")
+ (if arg
+ (guix-generation-list-diff-manifests)
+ (guix-generation-list-diff-packages)))
+
+(defun guix-generation-list-mark-delete (&optional arg)
+ "Mark the current generation for deletion and move to the next line.
+With ARG, mark all generations for deletion."
+ (interactive "P")
+ (if arg
+ (guix-list-mark-all 'delete)
+ (guix-list--mark 'delete t)))
+
+(defun guix-generation-list-execute ()
+ "Delete marked generations."
+ (interactive)
+ (let ((marked (guix-list-get-marked-id-list 'delete)))
+ (or marked
+ (user-error "No generations marked for deletion"))
+ (guix-delete-generations (guix-ui-current-profile)
+ marked (current-buffer))))
+
+
+;;; Inserting packages to compare generations
+
+(defcustom guix-generation-packages-buffer-name-function
+ #'guix-generation-packages-buffer-name-default
+ "Function used to define name of a buffer with generation packages.
+This function is called with 2 arguments: PROFILE (string) and
+GENERATION (number)."
+ :type '(choice (function-item guix-generation-packages-buffer-name-default)
+ (function-item guix-generation-packages-buffer-name-long)
+ (function :tag "Other function"))
+ :group 'guix-generation)
+
+(defcustom guix-generation-packages-update-buffer t
+ "If non-nil, always update list of packages during comparing generations.
+If nil, generation packages are received only once. So when you
+compare generation 1 and generation 2, the packages for both
+generations will be received. Then if you compare generation 1
+and generation 3, only the packages for generation 3 will be
+received. Thus if you use comparing of different generations a
+lot, you may set this variable to nil to improve the
+performance."
+ :type 'boolean
+ :group 'guix-generation)
+
+(defvar guix-generation-output-name-width 30
+ "Width of an output name \"column\".
+This variable is used in auxiliary buffers for comparing generations.")
+
+(defun guix-generation-packages (profile generation)
+ "Return a list of sorted packages installed in PROFILE's GENERATION.
+Each element of the list is a list of the package specification
+and its store path."
+ (let ((names+paths (guix-eval-read
+ (guix-make-guile-expression
+ 'generation-package-specifications+paths
+ profile generation))))
+ (sort names+paths
+ (lambda (a b)
+ (string< (car a) (car b))))))
+
+(defun guix-generation-packages-buffer-name-default (profile generation)
+ "Return name of a buffer for displaying GENERATION's package outputs.
+Use base name of PROFILE file name."
+ (let ((profile-name (file-name-base (directory-file-name profile))))
+ (format "*Guix %s: generation %s*"
+ profile-name generation)))
+
+(defun guix-generation-packages-buffer-name-long (profile generation)
+ "Return name of a buffer for displaying GENERATION's package outputs.
+Use the full PROFILE file name."
+ (format "*Guix generation %s (%s)*"
+ generation profile))
+
+(defun guix-generation-packages-buffer-name (profile generation)
+ "Return name of a buffer for displaying GENERATION's package outputs."
+ (funcall guix-generation-packages-buffer-name-function
+ profile generation))
+
+(defun guix-generation-insert-package (name path)
+ "Insert package output NAME and store PATH at point."
+ (insert name)
+ (indent-to guix-generation-output-name-width 2)
+ (insert path "\n"))
+
+(defun guix-generation-insert-packages (buffer profile generation)
+ "Insert package outputs installed in PROFILE's GENERATION in BUFFER."
+ (with-current-buffer buffer
+ (setq buffer-read-only nil
+ indent-tabs-mode nil)
+ (erase-buffer)
+ (mapc (lambda (name+path)
+ (guix-generation-insert-package
+ (car name+path) (cadr name+path)))
+ (guix-generation-packages profile generation))))
+
+(defun guix-generation-packages-buffer (profile generation)
+ "Return buffer with package outputs installed in PROFILE's GENERATION.
+Create the buffer if needed."
+ (let ((buf-name (guix-generation-packages-buffer-name
+ profile generation)))
+ (or (and (null guix-generation-packages-update-buffer)
+ (get-buffer buf-name))
+ (let ((buf (get-buffer-create buf-name)))
+ (guix-generation-insert-packages buf profile generation)
+ buf))))
+
+(defun guix-profile-generation-manifest-file (generation)
+ "Return the file name of a GENERATION's manifest.
+GENERATION is a generation number of the current profile."
+ (guix-manifest-file (guix-ui-current-profile) generation))
+
+(defun guix-profile-generation-packages-buffer (generation)
+ "Insert GENERATION's package outputs in a buffer and return it.
+GENERATION is a generation number of the current profile."
+ (guix-generation-packages-buffer (guix-ui-current-profile)
+ generation))
+
+
+;;; Interactive commands
+
+;;;###autoload
+(defun guix-generations (&optional profile)
+ "Display information about all generations.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-generation-get-display profile 'all))
+
+;;;###autoload
+(defun guix-last-generations (number &optional profile)
+ "Display information about last NUMBER generations.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (read-number "The number of last generations: ")
+ (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-generation-get-display profile 'last number))
+
+;;;###autoload
+(defun guix-generations-by-time (from to &optional profile)
+ "Display information about generations created between FROM and TO.
+FROM and TO should be time values.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (guix-read-date "Find generations (from): ")
+ (guix-read-date "Find generations (to): ")
+ (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-generation-get-display profile 'time
+ (float-time from)
+ (float-time to)))
+
+(provide 'guix-ui-generation)
+
+;;; guix-ui-generation.el ends here
diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el
new file mode 100644
index 0000000..7cc58dd
--- /dev/null
+++ b/emacs/guix-ui-package.el
@@ -0,0 +1,960 @@
+;;; guix-ui-package.el --- Interface for displaying packages -*-
lexical-binding: t -*-
+
+;; Copyright © 2014, 2015 Alex Kost <address@hidden>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides an interface for displaying packages and outputs
+;; in 'list' and 'info' buffers, and commands for working with them.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'guix-buffer)
+(require 'guix-list)
+(require 'guix-info)
+(require 'guix-ui)
+(require 'guix-base)
+(require 'guix-backend)
+(require 'guix-guile)
+(require 'guix-entry)
+(require 'guix-utils)
+
+(defgroup guix-package nil
+ "Interface for displaying packages and outputs."
+ :group 'guix-ui)
+
+(defcustom guix-package-list-type 'output
+ "Define how to display packages in 'list' buffer.
+Should 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)
+
+(defcustom guix-package-info-type 'package
+ "Define how to display packages in 'info' buffer.
+Should be a symbol `package' or `output' (if `output', display
+each output separately; if `package', display outputs inside
+package data)."
+ :type '(choice (const :tag "Display packages" package)
+ (const :tag "Display outputs" output))
+ :group 'guix-package)
+
+(defcustom guix-package-list-single nil
+ "If non-nil, list a package even if it is the only matching result.
+If nil, show a single package in the info buffer."
+ :type 'boolean
+ :group 'guix)
+
+(defun guix-package-get-display (profile search-type &rest search-values)
+ "Search for packages/outputs and show results.
+
+If PROFILE is nil, use `guix-current-profile'.
+
+See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
+SEARCH-VALUES.
+
+Results are displayed in the list buffer, unless a single package
+is found and `guix-package-list-single' is nil."
+ (let* ((args (cl-list* (or profile guix-current-profile)
+ search-type search-values))
+ (entries (guix-buffer-get-entries
+ 'list guix-package-list-type args)))
+ (if (or guix-package-list-single
+ (null entries)
+ (cdr entries))
+ (guix-buffer-display-entries
+ entries 'list guix-package-list-type args 'add)
+ (guix-buffer-get-display-entries
+ 'info guix-package-info-type args 'add))))
+
+(defun guix-package-entry->name-specification (entry &optional output)
+ "Return name specification of the package ENTRY and OUTPUT."
+ (guix-package-name-specification
+ (guix-entry-value entry 'name)
+ (guix-entry-value entry 'version)
+ (or output (guix-entry-value entry 'output))))
+
+(defun guix-package-entries->name-specifications (entries)
+ "Return name specifications by the package or output ENTRIES."
+ (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification
+ entries)
+ :test #'string=))
+
+(defun guix-package-installed-outputs (entry)
+ "Return a list of installed outputs for the package ENTRY."
+ (mapcar (lambda (installed-entry)
+ (guix-entry-value installed-entry 'output))
+ (guix-entry-value entry 'installed)))
+
+(defun guix-package-id-and-output-by-output-id (output-id)
+ "Return a list (PACKAGE-ID OUTPUT) by OUTPUT-ID."
+ (cl-multiple-value-bind (package-id-str output)
+ (split-string output-id ":")
+ (let ((package-id (string-to-number package-id-str)))
+ (list (if (= 0 package-id) package-id-str package-id)
+ output))))
+
+
+;;; Processing package actions
+
+(defun guix-process-package-actions (profile actions
+ &optional operation-buffer)
+ "Process package ACTIONS on PROFILE.
+Each action is a list of the form:
+
+ (ACTION-TYPE PACKAGE-SPEC ...)
+
+ACTION-TYPE is one of the following symbols: `install',
+`upgrade', `remove'/`delete'.
+PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
+ (let (install upgrade remove)
+ (mapc (lambda (action)
+ (let ((action-type (car action))
+ (specs (cdr action)))
+ (cl-case action-type
+ (install (setq install (append install specs)))
+ (upgrade (setq upgrade (append upgrade specs)))
+ ((remove delete) (setq remove (append remove specs))))))
+ actions)
+ (when (guix-continue-package-operation-p
+ profile
+ :install install :upgrade upgrade :remove remove)
+ (guix-eval-in-repl
+ (guix-make-guile-expression
+ 'process-package-actions profile
+ :install install :upgrade upgrade :remove remove
+ :use-substitutes? (or guix-use-substitutes 'f)
+ :dry-run? (or guix-dry-run 'f))
+ (and (not guix-dry-run) operation-buffer)))))
+
+(cl-defun guix-continue-package-operation-p (profile
+ &key install upgrade remove)
+ "Return non-nil if a package operation should be continued.
+Ask a user if needed (see `guix-operation-confirm').
+INSTALL, UPGRADE, REMOVE are 'package action specifications'.
+See `guix-process-package-actions' for details."
+ (or (null guix-operation-confirm)
+ (let* ((entries (guix-ui-get-entries
+ profile 'package 'id
+ (append (mapcar #'car install)
+ (mapcar #'car upgrade)
+ (mapcar #'car remove))
+ '(id name version location)))
+ (install-strings (guix-get-package-strings install entries))
+ (upgrade-strings (guix-get-package-strings upgrade entries))
+ (remove-strings (guix-get-package-strings remove entries)))
+ (if (or install-strings upgrade-strings remove-strings)
+ (let ((buf (get-buffer-create guix-temp-buffer-name)))
+ (with-current-buffer buf
+ (setq-local cursor-type nil)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert "Profile: " profile "\n\n")
+ (guix-insert-package-strings install-strings "install")
+ (guix-insert-package-strings upgrade-strings "upgrade")
+ (guix-insert-package-strings remove-strings "remove")
+ (let ((win (temp-buffer-window-show
+ buf
+ '((display-buffer-reuse-window
+ display-buffer-at-bottom)
+ (window-height . fit-window-to-buffer)))))
+ (prog1 (guix-operation-prompt)
+ (quit-window nil win)))))
+ (message "Nothing to be done.
+If Guix REPL was restarted, the data is not up-to-date.")
+ nil))))
+
+(defun guix-get-package-strings (specs entries)
+ "Return short package descriptions for performing package actions.
+See `guix-process-package-actions' for the meaning of SPECS.
+ENTRIES is a list of package entries to get info about packages."
+ (delq nil
+ (mapcar
+ (lambda (spec)
+ (let* ((id (car spec))
+ (outputs (cdr spec))
+ (entry (guix-entry-by-id id entries)))
+ (when entry
+ (let ((location (guix-entry-value entry 'location)))
+ (concat (guix-package-entry->name-specification entry)
+ (when outputs
+ (concat ":"
+ (guix-concat-strings outputs ",")))
+ (when location
+ (concat "\t(" location ")")))))))
+ specs)))
+
+(defun guix-insert-package-strings (strings action)
+ "Insert information STRINGS at point for performing package ACTION."
+ (when strings
+ (insert "Package(s) to " (propertize action 'face 'bold) ":\n")
+ (mapc (lambda (str)
+ (insert " " str "\n"))
+ strings)
+ (insert "\n")))
+
+
+;;; Package 'info'
+
+(guix-ui-info-define-interface package
+ :buffer-name "*Guix Package Info*"
+ :format '(guix-package-info-insert-heading
+ ignore
+ (synopsis ignore (simple guix-package-info-synopsis))
+ ignore
+ (description ignore (simple guix-package-info-description))
+ ignore
+ (outputs simple guix-package-info-insert-outputs)
+ (source simple guix-package-info-insert-source)
+ (location format (format guix-package-location))
+ (home-url format (format guix-url))
+ (license format (format guix-package-info-license))
+ (inputs format (format guix-package-input))
+ (native-inputs
+ format (format guix-package-native-input))
+ (propagated-inputs
+ format (format guix-package-propagated-input)))
+ :titles '((home-url . "Home page"))
+ :required '(id name version installed non-unique))
+
+(guix-info-define-interface installed-output
+ :format '((path simple (indent guix-file))
+ (dependencies simple (indent guix-file)))
+ :titles '((path . "Store directory"))
+ :reduced? t)
+
+(defface guix-package-info-heading
+ '((t :inherit guix-info-heading))
+ "Face for package name and version headings."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-name
+ '((t :inherit font-lock-keyword-face))
+ "Face used for a name of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-name-button
+ '((t :inherit button))
+ "Face used for a full name that can be used to describe a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-version
+ '((t :inherit font-lock-builtin-face))
+ "Face used for a version of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-synopsis
+ '((((type tty pc) (class color)) :weight bold)
+ (t :height 1.1 :weight bold :inherit variable-pitch))
+ "Face used for a synopsis of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-description
+ '((t))
+ "Face used for a description of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-license
+ '((t :inherit font-lock-string-face))
+ "Face used for a license of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-location
+ '((t :inherit link))
+ "Face used for a location of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-source
+ '((t :inherit link :underline nil))
+ "Face used for a source URL of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-installed-outputs
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background light))
+ :foreground "ForestGreen")
+ (((class color) (min-colors 88) (background dark))
+ :foreground "PaleGreen")
+ (((class color) (min-colors 8))
+ :foreground "green")
+ (t :underline t))
+ "Face used for installed outputs of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-uninstalled-outputs
+ '((t :weight bold))
+ "Face used for uninstalled outputs of a package."
+ :group 'guix-package-info-faces)
+
+(defface guix-package-info-obsolete
+ '((t :inherit error))
+ "Face used if a package is obsolete."
+ :group 'guix-package-info-faces)
+
+(defcustom guix-package-info-auto-find-source nil
+ "If non-nil, find a source file after pressing a \"Show\" button.
+If nil, just display the source file path without finding."
+ :type 'boolean
+ :group 'guix-package-info)
+
+(defcustom guix-package-info-auto-download-source t
+ "If nil, do not automatically download a source file if it doesn't exist.
+After pressing a \"Show\" button, a derivation of the package
+source is calculated and a store file path is displayed. If this
+variable is non-nil and the source file does not exist in the
+store, it will be automatically downloaded (with a possible
+prompt depending on `guix-operation-confirm' variable)."
+ :type 'boolean
+ :group 'guix-package-info)
+
+(defvar guix-package-info-download-buffer nil
+ "Buffer from which a current download operation was performed.")
+
+(defvar guix-package-info-output-format "%-10s"
+ "String used to format output names of the packages.
+It should be a '%s'-sequence. After inserting an output name
+formatted with this string, an action button is inserted.")
+
+(defvar guix-package-info-obsolete-string "(This package is obsolete)"
+ "String used if a package is obsolete.")
+
+(define-button-type 'guix-package-location
+ :supertype 'guix
+ 'face 'guix-package-info-location
+ 'help-echo "Find location of this package"
+ 'action (lambda (btn)
+ (guix-find-location (button-label btn))))
+
+(define-button-type 'guix-package-name
+ :supertype 'guix
+ 'face 'guix-package-info-name-button
+ 'help-echo "Describe this package"
+ 'action (lambda (btn)
+ (guix-buffer-get-display-entries-current
+ 'info guix-package-info-type
+ (list (guix-ui-current-profile)
+ 'name (button-label btn))
+ 'add)))
+
+(define-button-type 'guix-package-source
+ :supertype 'guix
+ 'face 'guix-package-info-source
+ 'help-echo ""
+ 'action (lambda (_)
+ ;; As a source may not be a real URL (e.g., "mirror://..."),
+ ;; no action is bound to a source button.
+ (message "Yes, this is the source URL. What did you expect?")))
+
+(defun guix-package-info-insert-heading (entry)
+ "Insert package ENTRY heading (name specification) at point."
+ (guix-insert-button
+ (guix-package-entry->name-specification entry)
+ 'guix-package-name
+ 'face 'guix-package-info-heading))
+
+(defmacro guix-package-info-define-insert-inputs (&optional type)
+ "Define a face and a function for inserting package inputs.
+TYPE is a type of inputs.
+Function name is `guix-package-info-insert-TYPE-inputs'.
+Face name is `guix-package-info-TYPE-inputs'."
+ (let* ((type-str (symbol-name type))
+ (type-name (and type (concat type-str "-")))
+ (type-desc (and type (concat type-str " ")))
+ (face (intern (concat "guix-package-info-" type-name "inputs")))
+ (btn (intern (concat "guix-package-" type-name "input"))))
+ `(progn
+ (defface ,face
+ '((t :inherit guix-package-info-name-button))
+ ,(concat "Face used for " type-desc "inputs of a package.")
+ :group 'guix-package-info-faces)
+
+ (define-button-type ',btn
+ :supertype 'guix-package-name
+ 'face ',face))))
+
+(guix-package-info-define-insert-inputs)
+(guix-package-info-define-insert-inputs native)
+(guix-package-info-define-insert-inputs propagated)
+
+(defun guix-package-info-insert-outputs (outputs entry)
+ "Insert OUTPUTS from package ENTRY at point."
+ (and (guix-entry-value entry 'obsolete)
+ (guix-package-info-insert-obsolete-text))
+ (and (guix-entry-value entry 'non-unique)
+ (guix-entry-value entry 'installed)
+ (guix-package-info-insert-non-unique-text
+ (guix-package-entry->name-specification entry)))
+ (insert "\n")
+ (dolist (output outputs)
+ (guix-package-info-insert-output output entry)))
+
+(defun guix-package-info-insert-obsolete-text ()
+ "Insert a message about obsolete package at point."
+ (guix-info-insert-indent)
+ (guix-format-insert guix-package-info-obsolete-string
+ 'guix-package-info-obsolete))
+
+(defun guix-package-info-insert-non-unique-text (full-name)
+ "Insert a message about non-unique package with FULL-NAME at point."
+ (insert "\n")
+ (guix-info-insert-indent)
+ (insert "Installed outputs are displayed for a non-unique ")
+ (guix-insert-button full-name 'guix-package-name)
+ (insert " package."))
+
+(defun guix-package-info-insert-output (output entry)
+ "Insert OUTPUT at point.
+Make some fancy text with buttons and additional stuff if the
+current OUTPUT is installed (if there is such output in
+`installed' parameter of a package ENTRY)."
+ (let* ((installed (guix-entry-value entry 'installed))
+ (obsolete (guix-entry-value entry 'obsolete))
+ (installed-entry (cl-find-if
+ (lambda (entry)
+ (string= (guix-entry-value entry 'output)
+ output))
+ installed))
+ (action-type (if installed-entry 'delete 'install)))
+ (guix-info-insert-indent)
+ (guix-format-insert output
+ (if installed-entry
+ 'guix-package-info-installed-outputs
+ 'guix-package-info-uninstalled-outputs)
+ guix-package-info-output-format)
+ (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))
+ (insert "\n")
+ (when installed-entry
+ (guix-info-insert-entry installed-entry 'installed-output 2))))
+
+(defun guix-package-info-insert-action-button (type entry output)
+ "Insert button to process an action on a package OUTPUT at point.
+TYPE is one of the following symbols: `install', `delete', `upgrade'.
+ENTRY is an alist with package info."
+ (let ((type-str (capitalize (symbol-name type)))
+ (full-name (guix-package-entry->name-specification entry output)))
+ (guix-info-insert-action-button
+ type-str
+ (lambda (btn)
+ (guix-process-package-actions
+ (guix-ui-current-profile)
+ `((,(button-get btn 'action-type) (,(button-get btn 'id)
+ ,(button-get btn 'output))))
+ (current-buffer)))
+ (concat type-str " '" full-name "'")
+ 'action-type type
+ 'id (or (guix-entry-value entry 'package-id)
+ (guix-entry-id entry))
+ 'output output)))
+
+(defun guix-package-info-show-source (entry-id package-id)
+ "Show file name of a package source in the current info buffer.
+Find the file if needed (see `guix-package-info-auto-find-source').
+ENTRY-ID is an ID of the current entry (package or output).
+PACKAGE-ID is an ID of the package which source to show."
+ (let* ((entries (guix-buffer-current-entries))
+ (entry (guix-entry-by-id entry-id entries))
+ (file (guix-package-source-path package-id)))
+ (or file
+ (error "Couldn't define file name of the package source"))
+ (let* ((new-entry (cons (cons 'source-file file)
+ entry))
+ (new-entries (guix-replace-entry entry-id new-entry entries)))
+ (setf (guix-buffer-item-entries guix-buffer-item)
+ new-entries)
+ (guix-buffer-redisplay-goto-button)
+ (if (file-exists-p file)
+ (if guix-package-info-auto-find-source
+ (guix-find-file file)
+ (message "The source store path is displayed."))
+ (if guix-package-info-auto-download-source
+ (guix-package-info-download-source package-id)
+ (message "The source does not exist in the store."))))))
+
+(defun guix-package-info-download-source (package-id)
+ "Download a source of the package PACKAGE-ID."
+ (setq guix-package-info-download-buffer (current-buffer))
+ (guix-package-source-build-derivation
+ package-id
+ "The source does not exist in the store. Download it?"))
+
+(defun guix-package-info-insert-source (source entry)
+ "Insert SOURCE from package ENTRY at point.
+SOURCE is a list of URLs."
+ (if (null source)
+ (guix-format-insert nil)
+ (let* ((source-file (guix-entry-value entry 'source-file))
+ (entry-id (guix-entry-id entry))
+ (package-id (or (guix-entry-value entry 'package-id)
+ entry-id)))
+ (if (null source-file)
+ (guix-info-insert-action-button
+ "Show"
+ (lambda (btn)
+ (guix-package-info-show-source (button-get btn 'entry-id)
+ (button-get btn 'package-id)))
+ "Show the source store directory of the current package"
+ 'entry-id entry-id
+ 'package-id package-id)
+ (unless (file-exists-p source-file)
+ (guix-info-insert-action-button
+ "Download"
+ (lambda (btn)
+ (guix-package-info-download-source
+ (button-get btn 'package-id)))
+ "Download the source into the store"
+ 'package-id package-id))
+ (guix-info-insert-value-indent source-file 'guix-file))
+ (guix-info-insert-value-indent source 'guix-package-source))))
+
+(defun guix-package-info-redisplay-after-download ()
+ "Redisplay an 'info' buffer after downloading the package source.
+This function is used to hide a \"Download\" button if needed."
+ (when (buffer-live-p guix-package-info-download-buffer)
+ (with-current-buffer guix-package-info-download-buffer
+ (guix-buffer-redisplay-goto-button))
+ (setq guix-package-info-download-buffer nil)))
+
+(add-hook 'guix-after-source-download-hook
+ 'guix-package-info-redisplay-after-download)
+
+
+;;; Package 'list'
+
+(guix-ui-list-define-interface package
+ :buffer-name "*Guix Package List*"
+ :format '((name guix-package-list-get-name 20 t)
+ (version nil 10 nil)
+ (outputs nil 13 t)
+ (installed guix-package-list-get-installed-outputs 13 t)
+ (synopsis guix-list-get-one-line 30 nil))
+ :sort-key '(name)
+ :marks '((install . ?I)
+ (upgrade . ?U)
+ (delete . ?D)))
+
+(let ((map guix-package-list-mode-map))
+ (define-key map (kbd "e") 'guix-package-list-edit)
+ (define-key map (kbd "x") 'guix-package-list-execute)
+ (define-key map (kbd "i") 'guix-package-list-mark-install)
+ (define-key map (kbd "d") 'guix-package-list-mark-delete)
+ (define-key map (kbd "U") 'guix-package-list-mark-upgrade)
+ (define-key map (kbd "^") 'guix-package-list-mark-upgrades))
+
+(defface guix-package-list-installed
+ '((t :inherit guix-package-info-installed-outputs))
+ "Face used if there are installed outputs for the current package."
+ :group 'guix-package-list-faces)
+
+(defface guix-package-list-obsolete
+ '((t :inherit guix-package-info-obsolete))
+ "Face used if a package is obsolete."
+ :group 'guix-package-list-faces)
+
+(defcustom guix-package-list-generation-marking-enabled nil
+ "If non-nil, allow putting marks in a list with 'generation packages'.
+
+By default this is disabled, because it may be confusing. For
+example, a package is installed in some generation, so a user can
+mark it for deletion in the list of packages from this
+generation, but the package may not be installed in the latest
+generation, so actually it cannot be deleted.
+
+If you managed to understand the explanation above or if you
+really know what you do or if you just don't care, you can set
+this variable to t. It should not do much harm anyway (most
+likely)."
+ :type 'boolean
+ :group 'guix-package-list)
+
+(defun guix-package-list-get-name (name entry)
+ "Return NAME of the package ENTRY.
+Colorize it with `guix-package-list-installed' or
+`guix-package-list-obsolete' if needed."
+ (guix-get-string name
+ (cond ((guix-entry-value entry 'obsolete)
+ 'guix-package-list-obsolete)
+ ((guix-entry-value entry 'installed)
+ 'guix-package-list-installed))))
+
+(defun guix-package-list-get-installed-outputs (installed &optional _)
+ "Return string with outputs from INSTALLED entries."
+ (guix-get-string
+ (mapcar (lambda (entry)
+ (guix-entry-value entry 'output))
+ installed)))
+
+(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)
+ (or (derived-mode-p 'guix-package-list-mode)
+ (derived-mode-p 'guix-output-list-mode))
+ (eq (guix-ui-current-search-type) 'generation))
+ (error "Action marks are disabled for lists of 'generation packages'")))
+
+(defun guix-package-list-mark-outputs (mark default
+ &optional prompt available)
+ "Mark the current package with MARK and move to the next line.
+If PROMPT is non-nil, use it to ask a user for outputs from
+AVAILABLE list, otherwise mark all DEFAULT outputs."
+ (let ((outputs (if prompt
+ (guix-completing-read-multiple
+ prompt available nil t)
+ default)))
+ (apply #'guix-list--mark mark t outputs)))
+
+(defun guix-package-list-mark-install (&optional arg)
+ "Mark the current package for installation and move to the next line.
+With ARG, prompt for the outputs to install (several outputs may
+be separated with \",\")."
+ (interactive "P")
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (all (guix-entry-value entry 'outputs))
+ (installed (guix-package-installed-outputs entry))
+ (available (cl-set-difference all installed :test #'string=)))
+ (or available
+ (user-error "This package is already installed"))
+ (guix-package-list-mark-outputs
+ 'install '("out")
+ (and arg "Output(s) to install: ")
+ available)))
+
+(defun guix-package-list-mark-delete (&optional arg)
+ "Mark the current package for deletion and move to the next line.
+With ARG, prompt for the outputs to delete (several outputs may
+be separated with \",\")."
+ (interactive "P")
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-package-installed-outputs entry)))
+ (or installed
+ (user-error "This package is not installed"))
+ (guix-package-list-mark-outputs
+ 'delete installed
+ (and arg "Output(s) to delete: ")
+ installed)))
+
+(defun guix-package-list-mark-upgrade (&optional arg)
+ "Mark the current package for upgrading and move to the next line.
+With ARG, prompt for the outputs to upgrade (several outputs may
+be separated with \",\")."
+ (interactive "P")
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-package-installed-outputs entry)))
+ (or installed
+ (user-error "This package is not installed"))
+ (when (or (guix-entry-value entry 'obsolete)
+ (y-or-n-p "This package is not obsolete. Try to upgrade it
anyway? "))
+ (guix-package-list-mark-outputs
+ 'upgrade installed
+ (and arg "Output(s) to upgrade: ")
+ installed))))
+
+(defun guix-package-mark-upgrades (fun)
+ "Mark all obsolete packages for upgrading.
+Use FUN to perform marking of the current line. FUN should
+take an entry as argument."
+ (guix-package-list-marking-check)
+ (let ((obsolete (cl-remove-if-not
+ (lambda (entry)
+ (guix-entry-value entry 'obsolete))
+ (guix-buffer-current-entries))))
+ (guix-list-for-each-line
+ (lambda ()
+ (let* ((id (guix-list-current-id))
+ (entry (cl-find-if
+ (lambda (entry)
+ (equal id (guix-entry-id entry)))
+ obsolete)))
+ (when entry
+ (funcall fun entry)))))))
+
+(defun guix-package-list-mark-upgrades ()
+ "Mark all obsolete packages for upgrading."
+ (interactive)
+ (guix-package-mark-upgrades
+ (lambda (entry)
+ (apply #'guix-list--mark
+ 'upgrade nil
+ (guix-package-installed-outputs entry)))))
+
+(defun guix-package-execute-actions (fun)
+ "Perform actions on the marked packages.
+Use FUN to define actions suitable for `guix-process-package-actions'.
+FUN should take action-type as argument."
+ (let ((actions (delq nil
+ (mapcar fun '(install delete upgrade)))))
+ (if actions
+ (guix-process-package-actions (guix-ui-current-profile)
+ actions (current-buffer))
+ (user-error "No operations specified"))))
+
+(defun guix-package-list-execute ()
+ "Perform actions on the marked packages."
+ (interactive)
+ (guix-package-execute-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.
+The specification is suitable for `guix-process-package-actions'."
+ (let ((specs (guix-list-get-marked-args action-type)))
+ (and specs (cons action-type specs))))
+
+(defun guix-package-list-edit ()
+ "Go to the location of the current package."
+ (interactive)
+ (guix-edit (guix-list-current-id)))
+
+
+;;; Output 'info'
+
+(guix-ui-info-define-interface output
+ :buffer-name "*Guix Package Info*"
+ :format '((name format (format guix-package-info-name))
+ (version format guix-output-info-insert-version)
+ (output format guix-output-info-insert-output)
+ (synopsis format (format guix-package-info-synopsis))
+ (source simple guix-package-info-insert-source)
+ (path simple (indent guix-file))
+ (dependencies simple (indent guix-file))
+ (location format (format guix-package-location))
+ (home-url format (format guix-url))
+ (license format (format guix-package-info-license))
+ (inputs format (format guix-package-input))
+ (native-inputs
+ format (format guix-package-native-input))
+ (propagated-inputs
+ format (format guix-package-propagated-input))
+ (description format (format guix-package-info-description)))
+ :titles '((home-url . "Home page"))
+ :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-value-format version
+ 'guix-package-info-version)
+ (and (guix-entry-value 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-entry-value entry 'installed))
+ (obsolete (guix-entry-value entry 'obsolete))
+ (action-type (if installed 'delete 'install)))
+ (guix-info-insert-value-format
+ 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))))
+
+
+;;; Output 'list'
+
+(guix-ui-list-define-interface output
+ :buffer-name "*Guix Package List*"
+ :describe-function 'guix-output-list-describe
+ :format '((name guix-package-list-get-name 20 t)
+ (version nil 10 nil)
+ (output nil 9 t)
+ (installed nil 12 t)
+ (synopsis guix-list-get-one-line 30 nil))
+ :required '(id package-id)
+ :sort-key '(name)
+ :marks '((install . ?I)
+ (upgrade . ?U)
+ (delete . ?D)))
+
+(let ((map guix-output-list-mode-map))
+ (define-key map (kbd "e") 'guix-output-list-edit)
+ (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-entry-value 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-entry-value 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 upgrading and move to the next line."
+ (interactive)
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-entry-value entry 'installed)))
+ (or installed
+ (user-error "This output is not installed"))
+ (when (or (guix-entry-value 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-package-mark-upgrades
+ (lambda (_) (guix-list--mark 'upgrade))))
+
+(defun guix-output-list-execute ()
+ "Perform actions on the marked outputs."
+ (interactive)
+ (guix-package-execute-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-package-id-and-output-by-output-id
+ ids)))))
+
+(defun guix-output-list-describe (ids)
+ "Describe outputs with IDS (list of output identifiers).
+See `guix-package-info-type'."
+ (if (eq guix-package-info-type 'output)
+ (guix-buffer-get-display-entries
+ 'info 'output
+ (cl-list* (guix-ui-current-profile) 'id ids)
+ 'add)
+ (let ((pids (mapcar (lambda (oid)
+ (car (guix-package-id-and-output-by-output-id
+ oid)))
+ ids)))
+ (guix-buffer-get-display-entries
+ 'info 'package
+ (cl-list* (guix-ui-current-profile)
+ 'id (cl-remove-duplicates pids))
+ 'add))))
+
+(defun guix-output-list-edit ()
+ "Go to the location of the current package."
+ (interactive)
+ (guix-edit (guix-entry-value (guix-list-current-entry)
+ 'package-id)))
+
+
+;;; Interactive commands
+
+(defvar guix-package-search-params '(name synopsis description)
+ "Default list of package parameters for searching by regexp.")
+
+(defvar guix-package-search-history nil
+ "A history of minibuffer prompts.")
+
+;;;###autoload
+(defun guix-search-by-name (name &optional profile)
+ "Search for Guix packages by NAME.
+NAME is a string with name specification. It may optionally contain
+a version number. Examples: \"guile\", \"guile-2.0.11\".
+
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (read-string "Package name: " nil 'guix-package-search-history)
+ (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-package-get-display profile 'name name))
+
+;;;###autoload
+(defun guix-search-by-regexp (regexp &optional params profile)
+ "Search for Guix packages by REGEXP.
+PARAMS are package parameters that should be searched.
+If PARAMS are not specified, use `guix-package-search-params'.
+
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (read-regexp "Regexp: " nil 'guix-package-search-history)
+ nil
+ (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-package-get-display profile 'regexp regexp
+ (or params guix-package-search-params)))
+
+;;;###autoload
+(defun guix-installed-packages (&optional profile)
+ "Display information about installed Guix packages.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-package-get-display profile 'installed))
+
+;;;###autoload
+(defun guix-obsolete-packages (&optional profile)
+ "Display information about obsolete Guix packages.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-package-get-display profile 'obsolete))
+
+;;;###autoload
+(defun guix-all-available-packages (&optional profile)
+ "Display information about all available Guix packages.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-package-get-display profile 'all-available))
+
+;;;###autoload
+(defun guix-newest-available-packages (&optional profile)
+ "Display information about the newest available Guix packages.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+ (interactive
+ (list (and current-prefix-arg
+ (guix-profile-prompt))))
+ (guix-package-get-display profile 'newest-available))
+
+(provide 'guix-ui-package)
+
+;;; guix-ui-package.el ends here
diff --git a/emacs/guix.el b/emacs/guix.el
deleted file mode 100644
index 12dd4a2..0000000
--- a/emacs/guix.el
+++ /dev/null
@@ -1,210 +0,0 @@
-;;; guix.el --- Interface for GNU Guix package manager
-
-;; Copyright © 2014, 2015 Alex Kost <address@hidden>
-
-;; Package-Requires: ((geiser "0.3"))
-;; Keywords: tools
-
-;; This file is part of GNU Guix.
-
-;; GNU Guix is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Guix is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package provides an interface for searching, listing and getting
-;; information about Guix packages and generations; and for
-;; installing/upgrading/removing packages.
-
-;;; Code:
-
-(require 'guix-base)
-(require 'guix-list)
-(require 'guix-info)
-(require 'guix-utils)
-(require 'guix-read)
-
-(defgroup guix nil
- "Interface for Guix package manager."
- :prefix "guix-"
- :group 'external)
-
-(defgroup guix-faces nil
- "Guix faces."
- :group 'guix
- :group 'faces)
-
-(defcustom guix-list-single-package nil
- "If non-nil, list a package even if it is the only matching result.
-If nil, show a single package in the info buffer."
- :type 'boolean
- :group 'guix)
-
-(defvar guix-search-params '(name synopsis description)
- "Default list of package parameters for searching by regexp.")
-
-(defvar guix-search-history nil
- "A history of minibuffer prompts.")
-
-(defun guix-get-show-packages (profile search-type &rest search-values)
- "Search for packages and show results.
-
-If PROFILE is nil, use `guix-current-profile'.
-
-See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
-SEARCH-VALUES.
-
-Results are displayed in the list buffer, unless a single package
-is found and `guix-list-single-package' is nil."
- (let* ((args (cl-list* (or profile guix-current-profile)
- search-type search-values))
- (entries (guix-buffer-get-entries
- 'list guix-package-list-type args)))
- (if (or guix-list-single-package
- (null entries)
- (cdr entries))
- (guix-buffer-display-entries
- entries 'list guix-package-list-type args 'add)
- (guix-buffer-get-display-entries
- 'info guix-package-info-type args 'add))))
-
-(defun guix-get-show-generations (profile search-type &rest search-values)
- "Search for generations and show results.
-
-If PROFILE is nil, use `guix-current-profile'.
-
-See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
-SEARCH-VALUES."
- (let ((args (cl-list* (or profile guix-current-profile)
- search-type search-values)))
- (guix-buffer-get-display-entries
- 'list 'generation args 'add)))
-
-;;;###autoload
-(defun guix-search-by-name (name &optional profile)
- "Search for Guix packages by NAME.
-NAME is a string with name specification. It may optionally contain
-a version number. Examples: \"guile\", \"guile-2.0.11\".
-
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (read-string "Package name: " nil 'guix-search-history)
- (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-packages profile 'name name))
-
-;;;###autoload
-(defun guix-search-by-regexp (regexp &optional params profile)
- "Search for Guix packages by REGEXP.
-PARAMS are package parameters that should be searched.
-If PARAMS are not specified, use `guix-search-params'.
-
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (read-regexp "Regexp: " nil 'guix-search-history)
- nil
- (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-packages profile 'regexp regexp
- (or params guix-search-params)))
-
-;;;###autoload
-(defun guix-installed-packages (&optional profile)
- "Display information about installed Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-packages profile 'installed))
-
-;;;###autoload
-(defun guix-obsolete-packages (&optional profile)
- "Display information about obsolete Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-packages profile 'obsolete))
-
-;;;###autoload
-(defun guix-all-available-packages (&optional profile)
- "Display information about all available Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-packages profile 'all-available))
-
-;;;###autoload
-(defun guix-newest-available-packages (&optional profile)
- "Display information about the newest available Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-packages profile 'newest-available))
-
-;;;###autoload
-(defun guix-generations (&optional profile)
- "Display information about all generations.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-generations profile 'all))
-
-;;;###autoload
-(defun guix-last-generations (number &optional profile)
- "Display information about last NUMBER generations.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (read-number "The number of last generations: ")
- (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-generations profile 'last number))
-
-;;;###autoload
-(defun guix-generations-by-time (from to &optional profile)
- "Display information about generations created between FROM and TO.
-FROM and TO should be time values.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (guix-read-date "Find generations (from): ")
- (guix-read-date "Find generations (to): ")
- (and current-prefix-arg
- (guix-profile-prompt))))
- (guix-get-show-generations profile 'time
- (float-time from)
- (float-time to)))
-
-;;;###autoload
-(defun guix-edit (id-or-name)
- "Edit (go to location of) package with ID-OR-NAME."
- (interactive (list (guix-read-package-name)))
- (let ((loc (guix-package-location id-or-name)))
- (if loc
- (guix-find-location loc)
- (message "Couldn't find package location."))))
-
-(provide 'guix)
-
-;;; guix.el ends here
- 29/37: emacs: Reorganize 'readers' code., (continued)
- 29/37: emacs: Reorganize 'readers' code., Alex Kost, 2015/12/18
- 32/37: emacs: Add 'guix-list-get-display-entries'., Alex Kost, 2015/12/18
- 33/37: emacs: Return nil instead of "" in completing readers., Alex Kost, 2015/12/18
- 37/37: emacs: Use "B" key to display latest builds in package list., Alex Kost, 2015/12/18
- 26/37: emacs: Generalize buffer naming., Alex Kost, 2015/12/18
- 35/37: emacs: Add 'guix-ui-read-profile'., Alex Kost, 2015/12/18
- 34/37: emacs: Add hierarchy of customization groups., Alex Kost, 2015/12/18
- 16/37: emacs: info: Generalize inserting and formatting., Alex Kost, 2015/12/18
- 36/37: emacs: Add Hydra interface., Alex Kost, 2015/12/18
- 28/37: emacs: Generalize buffer interface., Alex Kost, 2015/12/18
- 30/37: emacs: Reorganize package/generation UI code.,
Alex Kost <=