summaryrefslogtreecommitdiff
path: root/emacs/guix-list.el
diff options
context:
space:
mode:
Diffstat (limited to 'emacs/guix-list.el')
-rw-r--r--emacs/guix-list.el449
1 files changed, 4 insertions, 445 deletions
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index f5c50389ed..719642ad07 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -1,4 +1,4 @@
-;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
+;;; guix-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*-
;; Copyright © 2014, 2015 Alex Kost <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."
@@ -534,446 +533,6 @@ Set up the current 'list' buffer for displaying '%s' entries."
,@%foreign-args))))))))
-;;; Displaying packages
-
-(guix-ui-list-define-interface package
- :buffer-name "*Guix Package List*"
- :format '((name guix-package-list-get-name 20 t)
- (version nil 10 nil)
- (outputs nil 13 t)
- (installed guix-package-list-get-installed-outputs 13 t)
- (synopsis guix-list-get-one-line 30 nil))
- :sort-key '(name)
- :marks '((install . ?I)
- (upgrade . ?U)
- (delete . ?D)))
-
-(defface guix-package-list-installed
- '((t :inherit guix-package-info-installed-outputs))
- "Face used if there are installed outputs for the current package."
- :group 'guix-package-list-faces)
-
-(defface guix-package-list-obsolete
- '((t :inherit guix-package-info-obsolete))
- "Face used if a package is obsolete."
- :group 'guix-package-list-faces)
-
-(defcustom guix-package-list-generation-marking-enabled nil
- "If non-nil, allow putting marks in a list with 'generation packages'.
-
-By default this is disabled, because it may be confusing. For
-example a package is installed in some generation, so a user can
-mark it for deletion in the list of packages from this
-generation, but the package may not be installed in the latest
-generation, so actually it cannot be deleted.
-
-If you managed to understand the explanation above or if you
-really know what you do or if you just don't care, you can set
-this variable to t. It should not do much harm anyway (most
-likely)."
- :type 'boolean
- :group 'guix-package-list)
-
-(let ((map guix-package-list-mode-map))
- (define-key map (kbd "e") 'guix-package-list-edit)
- (define-key map (kbd "x") 'guix-package-list-execute)
- (define-key map (kbd "i") 'guix-package-list-mark-install)
- (define-key map (kbd "d") 'guix-package-list-mark-delete)
- (define-key map (kbd "U") 'guix-package-list-mark-upgrade)
- (define-key map (kbd "^") 'guix-package-list-mark-upgrades))
-
-(defun guix-package-list-get-name (name entry)
- "Return NAME of the package ENTRY.
-Colorize it with `guix-package-list-installed' or
-`guix-package-list-obsolete' if needed."
- (guix-get-string name
- (cond ((guix-entry-value entry 'obsolete)
- 'guix-package-list-obsolete)
- ((guix-entry-value entry 'installed)
- 'guix-package-list-installed))))
-
-(defun guix-package-list-get-installed-outputs (installed &optional _)
- "Return string with outputs from INSTALLED entries."
- (guix-get-string
- (mapcar (lambda (entry)
- (guix-entry-value entry 'output))
- installed)))
-
-(defun guix-package-list-marking-check ()
- "Signal an error if marking is disabled for the current buffer."
- (when (and (not guix-package-list-generation-marking-enabled)
- (or (derived-mode-p 'guix-package-list-mode)
- (derived-mode-p 'guix-output-list-mode))
- (eq (guix-ui-current-search-type) 'generation))
- (error "Action marks are disabled for lists of 'generation packages'")))
-
-(defun guix-package-list-mark-outputs (mark default
- &optional prompt available)
- "Mark the current package with MARK and move to the next line.
-If PROMPT is non-nil, use it to ask a user for outputs from
-AVAILABLE list, otherwise mark all DEFAULT outputs."
- (let ((outputs (if prompt
- (guix-completing-read-multiple
- prompt available nil t)
- default)))
- (apply #'guix-list--mark mark t outputs)))
-
-(defun guix-package-list-mark-install (&optional arg)
- "Mark the current package for installation and move to the next line.
-With ARG, prompt for the outputs to install (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (all (guix-entry-value entry 'outputs))
- (installed (guix-package-installed-outputs entry))
- (available (cl-set-difference all installed :test #'string=)))
- (or available
- (user-error "This package is already installed"))
- (guix-package-list-mark-outputs
- 'install '("out")
- (and arg "Output(s) to install: ")
- available)))
-
-(defun guix-package-list-mark-delete (&optional arg)
- "Mark the current package for deletion and move to the next line.
-With ARG, prompt for the outputs to delete (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-package-installed-outputs entry)))
- (or installed
- (user-error "This package is not installed"))
- (guix-package-list-mark-outputs
- 'delete installed
- (and arg "Output(s) to delete: ")
- installed)))
-
-(defun guix-package-list-mark-upgrade (&optional arg)
- "Mark the current package for upgrading and move to the next line.
-With ARG, prompt for the outputs to upgrade (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-package-installed-outputs entry)))
- (or installed
- (user-error "This package is not installed"))
- (when (or (guix-entry-value entry 'obsolete)
- (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
- (guix-package-list-mark-outputs
- 'upgrade installed
- (and arg "Output(s) to upgrade: ")
- installed))))
-
-(defun guix-list-mark-package-upgrades (fun)
- "Mark all obsolete packages for upgrading.
-Use FUN to perform marking of the current line. FUN should
-accept an entry as argument."
- (guix-package-list-marking-check)
- (let ((obsolete (cl-remove-if-not
- (lambda (entry)
- (guix-entry-value entry 'obsolete))
- (guix-buffer-current-entries))))
- (guix-list-for-each-line
- (lambda ()
- (let* ((id (guix-list-current-id))
- (entry (cl-find-if
- (lambda (entry)
- (equal id (guix-entry-id entry)))
- obsolete)))
- (when entry
- (funcall fun entry)))))))
-
-(defun guix-package-list-mark-upgrades ()
- "Mark all obsolete packages for upgrading."
- (interactive)
- (guix-list-mark-package-upgrades
- (lambda (entry)
- (apply #'guix-list--mark
- 'upgrade nil
- (guix-package-installed-outputs entry)))))
-
-(defun guix-list-execute-package-actions (fun)
- "Perform actions on the marked packages.
-Use FUN to define actions suitable for `guix-process-package-actions'.
-FUN should accept action-type as argument."
- (let ((actions (delq nil
- (mapcar fun '(install delete upgrade)))))
- (if actions
- (guix-process-package-actions (guix-ui-current-profile)
- actions (current-buffer))
- (user-error "No operations specified"))))
-
-(defun guix-package-list-execute ()
- "Perform actions on the marked packages."
- (interactive)
- (guix-list-execute-package-actions #'guix-package-list-make-action))
-
-(defun guix-package-list-make-action (action-type)
- "Return action specification for the packages marked with ACTION-TYPE.
-Return nil, if there are no packages marked with ACTION-TYPE.
-The specification is suitable for `guix-process-package-actions'."
- (let ((specs (guix-list-get-marked-args action-type)))
- (and specs (cons action-type specs))))
-
-(defun guix-package-list-edit ()
- "Go to the location of the current package."
- (interactive)
- (guix-edit (guix-list-current-id)))
-
-
-;;; Displaying outputs
-
-(guix-ui-list-define-interface output
- :buffer-name "*Guix Package List*"
- :describe-function 'guix-output-list-describe
- :format '((name guix-package-list-get-name 20 t)
- (version nil 10 nil)
- (output nil 9 t)
- (installed nil 12 t)
- (synopsis guix-list-get-one-line 30 nil))
- :required '(id package-id)
- :sort-key '(name)
- :marks '((install . ?I)
- (upgrade . ?U)
- (delete . ?D)))
-
-(let ((map guix-output-list-mode-map))
- (define-key map (kbd "e") 'guix-output-list-edit)
- (define-key map (kbd "x") 'guix-output-list-execute)
- (define-key map (kbd "i") 'guix-output-list-mark-install)
- (define-key map (kbd "d") 'guix-output-list-mark-delete)
- (define-key map (kbd "U") 'guix-output-list-mark-upgrade)
- (define-key map (kbd "^") 'guix-output-list-mark-upgrades))
-
-(defun guix-output-list-mark-install ()
- "Mark the current output for installation and move to the next line."
- (interactive)
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-entry-value entry 'installed)))
- (if installed
- (user-error "This output is already installed")
- (guix-list--mark 'install t))))
-
-(defun guix-output-list-mark-delete ()
- "Mark the current output for deletion and move to the next line."
- (interactive)
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-entry-value entry 'installed)))
- (if installed
- (guix-list--mark 'delete t)
- (user-error "This output is not installed"))))
-
-(defun guix-output-list-mark-upgrade ()
- "Mark the current output for deletion and move to the next line."
- (interactive)
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-entry-value entry 'installed)))
- (or installed
- (user-error "This output is not installed"))
- (when (or (guix-entry-value entry 'obsolete)
- (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
- (guix-list--mark 'upgrade t))))
-
-(defun guix-output-list-mark-upgrades ()
- "Mark all obsolete package outputs for upgrading."
- (interactive)
- (guix-list-mark-package-upgrades
- (lambda (_) (guix-list--mark 'upgrade))))
-
-(defun guix-output-list-execute ()
- "Perform actions on the marked outputs."
- (interactive)
- (guix-list-execute-package-actions #'guix-output-list-make-action))
-
-(defun guix-output-list-make-action (action-type)
- "Return action specification for the outputs marked with ACTION-TYPE.
-Return nil, if there are no outputs marked with ACTION-TYPE.
-The specification is suitable for `guix-process-output-actions'."
- (let ((ids (guix-list-get-marked-id-list action-type)))
- (and ids (cons action-type
- (mapcar #'guix-package-id-and-output-by-output-id
- ids)))))
-
-(defun guix-output-list-describe (ids)
- "Describe outputs with IDS (list of output identifiers).
-See `guix-package-info-type'."
- (if (eq guix-package-info-type 'output)
- (guix-buffer-get-display-entries
- 'info 'output
- (cl-list* (guix-ui-current-profile) 'id ids)
- 'add)
- (let ((pids (mapcar (lambda (oid)
- (car (guix-package-id-and-output-by-output-id
- oid)))
- ids)))
- (guix-buffer-get-display-entries
- 'info 'package
- (cl-list* (guix-ui-current-profile)
- 'id (cl-remove-duplicates pids))
- 'add))))
-
-(defun guix-output-list-edit ()
- "Go to the location of the current package."
- (interactive)
- (guix-edit (guix-entry-value (guix-list-current-entry)
- 'package-id)))
-
-
-;;; Displaying generations
-
-(guix-ui-list-define-interface generation
- :buffer-name "*Guix Generation List*"
- :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
- (current guix-generation-list-get-current 10 t)
- (time guix-list-get-time 20 t)
- (path guix-list-get-file-path 30 t))
- :titles '((number . "N."))
- :sort-key '(number . t)
- :marks '((delete . ?D)))
-
-(let ((map guix-generation-list-mode-map))
- (define-key map (kbd "RET") 'guix-generation-list-show-packages)
- (define-key map (kbd "+") 'guix-generation-list-show-added-packages)
- (define-key map (kbd "-") 'guix-generation-list-show-removed-packages)
- (define-key map (kbd "=") 'guix-generation-list-diff)
- (define-key map (kbd "D") 'guix-generation-list-diff)
- (define-key map (kbd "e") 'guix-generation-list-ediff)
- (define-key map (kbd "x") 'guix-generation-list-execute)
- (define-key map (kbd "s") 'guix-generation-list-switch)
- (define-key map (kbd "d") 'guix-generation-list-mark-delete))
-
-(defun guix-generation-list-get-current (val &optional _)
- "Return string from VAL showing whether this generation is current.
-VAL is a boolean value."
- (if val "(current)" ""))
-
-(defun guix-generation-list-switch ()
- "Switch current profile to the generation at point."
- (interactive)
- (let* ((entry (guix-list-current-entry))
- (current (guix-entry-value entry 'current))
- (number (guix-entry-value entry 'number)))
- (if current
- (user-error "This generation is already the current one")
- (guix-switch-to-generation (guix-ui-current-profile)
- number (current-buffer)))))
-
-(defun guix-generation-list-show-packages ()
- "List installed packages for the generation at point."
- (interactive)
- (guix-get-show-packages
- (guix-ui-current-profile)
- 'generation (guix-list-current-id)))
-
-(defun guix-generation-list-generations-to-compare ()
- "Return a sorted list of 2 marked generations for comparing."
- (let ((numbers (guix-list-get-marked-id-list 'general)))
- (if (/= (length numbers) 2)
- (user-error "2 generations should be marked for comparing")
- (sort numbers #'<))))
-
-(defun guix-generation-list-show-added-packages ()
- "List package outputs added to the latest marked generation.
-If 2 generations are marked with \\[guix-list-mark], display
-outputs installed in the latest marked generation that were not
-installed in the other one."
- (interactive)
- (guix-buffer-get-display-entries
- 'list 'output
- (cl-list* (guix-ui-current-profile)
- 'generation-diff
- (reverse (guix-generation-list-generations-to-compare)))
- 'add))
-
-(defun guix-generation-list-show-removed-packages ()
- "List package outputs removed from the latest marked generation.
-If 2 generations are marked with \\[guix-list-mark], display
-outputs not installed in the latest marked generation that were
-installed in the other one."
- (interactive)
- (guix-buffer-get-display-entries
- 'list 'output
- (cl-list* (guix-ui-current-profile)
- 'generation-diff
- (guix-generation-list-generations-to-compare))
- 'add))
-
-(defun guix-generation-list-compare (diff-fun gen-fun)
- "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
- (cl-multiple-value-bind (gen1 gen2)
- (guix-generation-list-generations-to-compare)
- (funcall diff-fun
- (funcall gen-fun gen1)
- (funcall gen-fun gen2))))
-
-(defun guix-generation-list-ediff-manifests ()
- "Run Ediff on manifests of the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'ediff-files
- #'guix-profile-generation-manifest-file))
-
-(defun guix-generation-list-diff-manifests ()
- "Run Diff on manifests of the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'guix-diff
- #'guix-profile-generation-manifest-file))
-
-(defun guix-generation-list-ediff-packages ()
- "Run Ediff on package outputs installed in the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'ediff-buffers
- #'guix-profile-generation-packages-buffer))
-
-(defun guix-generation-list-diff-packages ()
- "Run Diff on package outputs installed in the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'guix-diff
- #'guix-profile-generation-packages-buffer))
-
-(defun guix-generation-list-ediff (arg)
- "Run Ediff on package outputs installed in the 2 marked generations.
-With ARG, run Ediff on manifests of the marked generations."
- (interactive "P")
- (if arg
- (guix-generation-list-ediff-manifests)
- (guix-generation-list-ediff-packages)))
-
-(defun guix-generation-list-diff (arg)
- "Run Diff on package outputs installed in the 2 marked generations.
-With ARG, run Diff on manifests of the marked generations."
- (interactive "P")
- (if arg
- (guix-generation-list-diff-manifests)
- (guix-generation-list-diff-packages)))
-
-(defun guix-generation-list-mark-delete (&optional arg)
- "Mark the current generation for deletion and move to the next line.
-With ARG, mark all generations for deletion."
- (interactive "P")
- (if arg
- (guix-list-mark-all 'delete)
- (guix-list--mark 'delete t)))
-
-(defun guix-generation-list-execute ()
- "Delete marked generations."
- (interactive)
- (let ((marked (guix-list-get-marked-id-list 'delete)))
- (or marked
- (user-error "No generations marked for deletion"))
- (guix-delete-generations (guix-ui-current-profile)
- marked (current-buffer))))
-
-
(defvar guix-list-font-lock-keywords
(eval-when-compile
`((,(rx "(" (group "guix-list-define-interface")