(require 'cl-lib)
(require 'tabulated-list)
(require 'guix-info)
-(require 'guix-history)
(require 'guix-base)
(require 'guix-utils)
"Return alist of the current entry info."
(guix-get-entry-by-id (guix-list-current-id) guix-entries))
+(defun guix-list-current-package-id ()
+ "Return ID of the current package."
+ (cl-ecase major-mode
+ (guix-package-list-mode
+ (guix-list-current-id))
+ (guix-output-list-mode
+ (guix-get-key-val (guix-list-current-entry) 'package-id))))
+
(defun guix-list-for-each-line (fun &rest args)
"Call FUN with ARGS for each entry line."
(or (derived-mode-p 'guix-list-mode)
See `guix-list-get-marked' for details."
(mapcar #'car (apply #'guix-list-get-marked mark-names)))
-(defun guix-list-mark (mark-name &optional advance &rest args)
+(defun guix-list--mark (mark-name &optional advance &rest args)
"Put a mark on the current line.
Also add the current entry to `guix-list-marked' using its ID and ARGS.
MARK-NAME is a symbol from `guix-list-mark-alist'.
-If ADVANCE is non-nil, move forward by one line after marking.
-Interactively, put a general mark and move to the next line."
- (interactive '(general t))
+If ADVANCE is non-nil, move forward by one line after marking."
(let ((id (guix-list-current-id)))
(if (eq mark-name 'empty)
(setq guix-list-marked (assq-delete-all id guix-list-marked))
(tabulated-list-put-tag (guix-list-get-mark-string mark-name)
advance))
-(defun guix-list-mark-all (mark-name)
+(defun guix-list-mark (&optional arg)
+ "Mark the current line and move to the next line.
+With ARG, mark all lines."
+ (interactive "P")
+ (if arg
+ (guix-list-mark-all)
+ (guix-list--mark 'general t)))
+
+(defun guix-list-mark-all (&optional mark-name)
"Mark all lines with MARK-NAME mark.
MARK-NAME is a symbol from `guix-list-mark-alist'.
Interactively, put a general mark on all lines."
- (interactive '(general))
- (guix-list-for-each-line #'guix-list-mark mark-name))
+ (interactive)
+ (or mark-name (setq mark-name 'general))
+ (guix-list-for-each-line #'guix-list--mark mark-name))
(defun guix-list-unmark (&optional arg)
"Unmark the current line and move to the next line.
(interactive "P")
(if arg
(guix-list-unmark-all)
- (guix-list-mark 'empty t)))
+ (guix-list--mark 'empty t)))
(defun guix-list-unmark-backward ()
"Move up one line and unmark it."
(interactive)
(forward-line -1)
- (guix-list-mark 'empty))
+ (guix-list--mark 'empty))
(defun guix-list-unmark-all ()
"Unmark all lines."
\f
(defvar guix-list-mode-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map tabulated-list-mode-map)
+ (set-keymap-parent
+ map (make-composed-keymap guix-root-map
+ tabulated-list-mode-map))
(define-key map (kbd "RET") 'guix-list-describe)
(define-key map (kbd "m") 'guix-list-mark)
(define-key map (kbd "*") 'guix-list-mark)
- (define-key map (kbd "M") 'guix-list-mark-all)
(define-key map (kbd "u") 'guix-list-unmark)
(define-key map (kbd "DEL") 'guix-list-unmark-backward)
(define-key map [remap tabulated-list-sort] 'guix-list-sort)
,(concat "Put '" mark-name-str "' mark and move to the next line.\n"
"Also add the current entry to `guix-list-marked'.")
(interactive)
- (guix-list-mark ',mark-name t))))
+ (guix-list--mark ',mark-name t))))
marks-val)
(defun ,init-fun ()
(when (or (<= count guix-list-describe-warning-count)
(y-or-n-p (format "Do you really want to describe %d entries? "
count)))
- (apply #'guix-get-show-entries 'info entry-type 'id ids))))
+ (apply #'guix-get-show-entries
+ guix-profile 'info entry-type 'id ids))))
(defun guix-list-describe (&optional arg)
"Describe entries marked with a general mark.
(list (guix-list-current-id)))))
(guix-list-describe-maybe guix-entry-type ids)))
+(defun guix-list-edit-package ()
+ "Go to the location of the current package."
+ (interactive)
+ (guix-edit-package (guix-list-current-package-id)))
+
\f
;;; Displaying packages
:group 'guix-package-list)
(let ((map guix-package-list-mode-map))
+ (define-key map (kbd "e") 'guix-list-edit-package)
(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)
(guix-completing-read-multiple
prompt available nil t)
default)))
- (apply #'guix-list-mark mark t outputs)))
+ (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.
(interactive)
(guix-list-mark-package-upgrades
(lambda (entry)
- (apply #'guix-list-mark
+ (apply #'guix-list--mark
'upgrade nil
(guix-get-installed-outputs entry)))))
(let ((actions (delq nil
(mapcar fun '(install delete upgrade)))))
(if actions
- (apply #'guix-process-package-actions actions)
+ (guix-process-package-actions
+ guix-profile actions (current-buffer))
(user-error "No operations specified"))))
(defun guix-package-list-execute ()
;;; Displaying outputs
(guix-define-buffer-type list output
- :buffer-name "*Guix Package List*")
+ :buffer-name "*Guix Package List*"
+ :required (package-id))
(guix-list-define-entry-type output
:sort-key name
(let ((map guix-output-list-mode-map))
(define-key map (kbd "RET") 'guix-output-list-describe)
+ (define-key map (kbd "e") 'guix-list-edit-package)
(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)
(installed (guix-get-key-val entry 'installed)))
(if installed
(user-error "This output is already installed")
- (guix-list-mark 'install t))))
+ (guix-list--mark 'install t))))
(defun guix-output-list-mark-delete ()
"Mark the current output for deletion and move to the next line."
(let* ((entry (guix-list-current-entry))
(installed (guix-get-key-val entry 'installed)))
(if installed
- (guix-list-mark 'delete t)
+ (guix-list--mark 'delete t)
(user-error "This output is not installed"))))
(defun guix-output-list-mark-upgrade ()
(user-error "This output is not installed"))
(when (or (guix-get-key-val entry 'obsolete)
(y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
- (guix-list-mark 'upgrade t))))
+ (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))))
+ (lambda (_) (guix-list--mark 'upgrade))))
(defun guix-output-list-execute ()
"Perform actions on the marked outputs."
(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 "i") 'guix-list-describe)
(define-key map (kbd "s") 'guix-generation-list-switch)
(number (guix-get-key-val entry 'number)))
(if current
(user-error "This generation is already the current one")
- (guix-switch-to-generation number))))
+ (guix-switch-to-generation guix-profile number (current-buffer)))))
(defun guix-generation-list-show-packages ()
"List installed packages for the generation at point."
(interactive)
- (guix-get-show-entries 'list guix-package-list-type 'generation
- (guix-list-current-id)))
+ (guix-get-show-entries guix-profile 'list guix-package-list-type
+ '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)
+ (apply #'guix-get-show-entries
+ guix-profile 'list 'output 'generation-diff
+ (reverse (guix-generation-list-generations-to-compare))))
+
+(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)
+ (apply #'guix-get-show-entries
+ guix-profile 'list 'output 'generation-diff
+ (guix-generation-list-generations-to-compare)))
+
+(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.
(interactive "P")
(if arg
(guix-list-mark-all 'delete)
- (guix-list-mark 'delete t)))
+ (guix-list--mark 'delete t)))
(defun guix-generation-list-execute ()
"Delete marked generations."
(let ((marked (guix-list-get-marked-id-list 'delete)))
(or marked
(user-error "No generations marked for deletion"))
- (apply #'guix-delete-generations marked)))
+ (guix-delete-generations guix-profile marked (current-buffer))))
(provide 'guix-list)
HCoop / jackhill / guix / guix.git / blobdiff