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.
This commit is contained in:
Alex Kost
parent
b1990426fd
commit
c80ce104be
|
|
@ -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
|
||||
|
||||
|
|
|
|||
5
emacs.am
5
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ...")
|
||||
|
|
|
|||
|
|
@ -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 <alezost@gmail.com>
|
||||
;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
|
|
@ -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."
|
||||
|
|
@ -358,24 +357,6 @@ BUTTON-OR-FACE is a button type)."
|
|||
'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."
|
||||
|
|
@ -495,434 +476,6 @@ Print '%s' ENTRIES in the current 'info' buffer."
|
|||
:mode-init-function 'guix-info-mode-initialize
|
||||
,@%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 simple (indent 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 simple (indent guix-package-info-description)))
|
||||
:titles guix-package-info-titles
|
||||
: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
|
||||
|
|
|
|||
|
|
@ -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 <alezost@gmail.com>
|
||||
|
||||
|
|
@ -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."
|
||||
|
|
@ -533,446 +532,6 @@ Set up the current 'list' buffer for displaying '%s' entries."
|
|||
:mode-init-function ',mode-init-fun
|
||||
,@%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
|
||||
|
|
|
|||
|
|
@ -0,0 +1,439 @@
|
|||
;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; 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
|
||||
|
|
@ -0,0 +1,958 @@
|
|||
;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; 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 simple (indent 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 simple (indent guix-package-info-description)))
|
||||
:titles guix-package-info-titles
|
||||
: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
|
||||
210
emacs/guix.el
210
emacs/guix.el
|
|
@ -1,210 +0,0 @@
|
|||
;;; guix.el --- Interface for GNU Guix package manager
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; 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
|
||||
Loading…
Reference in New Issue