(outputs 13 t)
(installed 13 t)
(synopsis 30 nil))
+ (output
+ (name 20 t)
+ (version 10 nil)
+ (output 9 t)
+ (installed 12 t)
+ (synopsis 30 nil))
(generation
(number 5
,(lambda (a b) (guix-list-sort-numerically 0 a b))
(synopsis . guix-list-get-one-line)
(description . guix-list-get-one-line)
(installed . guix-package-list-get-installed-outputs))
+ (output
+ (name . guix-package-list-get-name)
+ (synopsis . guix-list-get-one-line)
+ (description . guix-list-get-one-line))
(generation
(time . guix-list-get-time)
(path . guix-list-get-file-path)))
(interactive '(general))
(guix-list-for-each-line #'guix-list-mark mark-name))
-(defun guix-list-unmark ()
- "Unmark the current line and move to the next line."
- (interactive)
- (guix-list-mark 'empty t))
+(defun guix-list-unmark (&optional arg)
+ "Unmark the current line and move to the next line.
+With ARG, unmark all lines."
+ (interactive "P")
+ (if arg
+ (guix-list-unmark-all)
+ (guix-list-mark 'empty t)))
(defun guix-list-unmark-backward ()
"Move up one line and unmark it."
(defvar guix-list-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent 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 "U") 'guix-list-unmark-all)
(define-key map (kbd "DEL") 'guix-list-unmark-backward)
(define-key map [remap tabulated-list-sort] 'guix-list-sort)
map)
This macro defines the following functions:
- - `guix-ENTRY-TYPE-describe' - display marked entries in info buffer.
-
- `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark
specified in `:marks' argument."
(let* ((entry-type-str (symbol-name entry-type))
- (entry-str (concat entry-type-str " entries"))
(prefix (concat "guix-" entry-type-str "-list"))
(mode-str (concat prefix "-mode"))
(init-fun (intern (concat prefix "-mode-initialize")))
- (describe-fun (intern (concat prefix "-describe")))
(marks-var (intern (concat prefix "-mark-alist")))
(marks-val nil)
(sort-key nil)
(guix-list-mark ',mark-name t))))
marks-val)
- (defun ,describe-fun (&optional arg)
- ,(concat "Describe " entry-str " marked with a general mark.\n"
- "If no entry is marked, describe the current " entry-type-str ".\n"
- "With prefix (if ARG is non-nil), describe the " entry-str "\n"
- "marked with any mark.")
- (interactive "P")
- (let* ((ids (or (apply #'guix-list-get-marked-id-list
- (unless arg '(general)))
- (list (guix-list-current-id))))
- (count (length ids)))
- (when (or (<= count guix-list-describe-warning-count)
- (y-or-n-p (format "Do you really want to describe %d entries? "
- count)))
- (,(intern (concat "guix-" entry-type-str "-info-get-show"))
- 'id ids))))
-
(defun ,init-fun ()
,(concat "Initial settings for `" mode-str "'.")
,(when sort-key
(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
+(defun guix-list-describe-maybe (entry-type ids)
+ "Describe ENTRY-TYPE entries in info buffer using list of IDS."
+ (let ((count (length ids)))
+ (when (or (<= count guix-list-describe-warning-count)
+ (y-or-n-p (format "Do you really want to describe %d entries? "
+ count)))
+ (apply #'guix-get-show-entries 'info entry-type 'id ids))))
+
+(defun guix-list-describe (&optional arg)
+ "Describe entries marked with a general mark.
+If no entries are marked, describe the current entry.
+With prefix (if ARG is non-nil), describe entries marked with any mark."
+ (interactive "P")
+ (let ((ids (or (apply #'guix-list-get-marked-id-list
+ (unless arg '(general)))
+ (list (guix-list-current-id)))))
+ (guix-list-describe-maybe guix-entry-type ids)))
+
\f
;;; Displaying packages
"Face used if a package is obsolete."
:group 'guix-package-list)
+(defcustom guix-package-list-type 'output
+ "Define how to display packages in a list buffer.
+May be a symbol `package' or `output' (if `output', display each
+output on a separate line; if `package', display each package on
+a separate line)."
+ :type '(choice (const :tag "List of packages" package)
+ (const :tag "List of outputs" output))
+ :group 'guix-package-list)
+
(defcustom guix-package-list-generation-marking-enabled nil
"If non-nil, allow putting marks in a list with 'generation packages'.
:group 'guix-package-list)
(let ((map guix-package-list-mode-map))
- (define-key map (kbd "RET") 'guix-package-list-describe)
(define-key map (kbd "x") 'guix-package-list-execute)
(define-key map (kbd "i") 'guix-package-list-mark-install)
- (define-key map (kbd "^") 'guix-package-list-mark-upgrade)
- (define-key map (kbd "d") 'guix-package-list-mark-delete))
+ (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.
(defun guix-package-list-marking-check ()
"Signal an error if marking is disabled for the current buffer."
(when (and (not guix-package-list-generation-marking-enabled)
- (derived-mode-p 'guix-package-list-mode)
+ (or (derived-mode-p 'guix-package-list-mode)
+ (derived-mode-p 'guix-output-list-mode))
(eq guix-search-type 'generation))
(error "Action marks are disabled for lists of 'generation packages'")))
+(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))
- (available (guix-get-key-val entry 'outputs))
+ (let* ((entry (guix-list-current-entry))
+ (all (guix-get-key-val entry 'outputs))
(installed (guix-get-installed-outputs entry))
- (to-install (if arg
- (guix-completing-read-multiple
- "Output(s) to install: " available nil t)
- '("out")))
- (to-install (cl-set-difference to-install installed
- :test #'string=)))
- (if to-install
- (apply #'guix-list-mark 'install t to-install)
- (user-error "This package is already installed"))))
+ (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.
(installed (guix-get-installed-outputs entry)))
(or installed
(user-error "This package is not installed"))
- (let ((to-delete (when arg
- (guix-completing-read-multiple
- "Output(s) to delete: " installed nil t))))
- (if to-delete
- (apply #'guix-list-mark 'delete t to-delete)
- (guix-package-list-mark-delete-simple)))))
-
-(defun guix-package-list-mark-upgrade ()
- "Mark the current package for upgrading and move to the next line."
- (interactive)
+ (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)))
- (or (guix-get-installed-outputs entry)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-get-installed-outputs entry)))
+ (or installed
(user-error "This package is not installed"))
(when (or (guix-get-key-val entry 'obsolete)
(y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
- (guix-package-list-mark-upgrade-simple))))
-
-(defun guix-package-list-execute ()
- "Perform actions on the marked packages."
+ (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-get-key-val entry 'obsolete))
+ guix-entries)))
+ (guix-list-for-each-line
+ (lambda ()
+ (let* ((id (guix-list-current-id))
+ (entry (cl-find-if
+ (lambda (entry)
+ (equal id (guix-get-key-val entry 'id)))
+ 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-get-installed-outputs entry)))))
+
+(defun guix-list-execute-package-actions (fun)
+ "Perform actions on the marked packages.
+Use FUN to define actions suitable for `guix-process-package-actions'.
+FUN should accept action-type as argument."
(let ((actions (delq nil
- (mapcar #'guix-package-list-make-action
- '(install delete upgrade)))))
+ (mapcar fun '(install delete upgrade)))))
(if actions
(apply #'guix-process-package-actions actions)
(user-error "No operations specified"))))
+(defun guix-package-list-execute ()
+ "Perform actions on the marked packages."
+ (interactive)
+ (guix-list-execute-package-actions #'guix-package-list-make-action))
+
(defun guix-package-list-make-action (action-type)
"Return action specification for the packages marked with ACTION-TYPE.
Return nil, if there are no packages marked with ACTION-TYPE.
(and specs (cons action-type specs))))
\f
+;;; Displaying outputs
+
+(guix-define-buffer-type list output
+ :buffer-name "*Guix Package List*")
+
+(guix-list-define-entry-type output
+ :sort-key name
+ :marks ((install . ?I)
+ (upgrade . ?U)
+ (delete . ?D)))
+
+(defcustom guix-output-list-describe-type 'package
+ "Define how to describe outputs in a list buffer.
+May be a symbol `package' or `output' (if `output', describe only
+marked outputs; if `package', describe all outputs of the marked
+packages)."
+ :type '(choice (const :tag "Describe packages" package)
+ (const :tag "Describe outputs" output))
+ :group 'guix-output-list)
+
+(let ((map guix-output-list-mode-map))
+ (define-key map (kbd "RET") 'guix-output-list-describe)
+ (define-key map (kbd "x") 'guix-output-list-execute)
+ (define-key map (kbd "i") 'guix-output-list-mark-install)
+ (define-key map (kbd "d") 'guix-output-list-mark-delete)
+ (define-key map (kbd "U") 'guix-output-list-mark-upgrade)
+ (define-key map (kbd "^") 'guix-output-list-mark-upgrades))
+
+(defun guix-output-list-mark-install ()
+ "Mark the current output for installation and move to the next line."
+ (interactive)
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-get-key-val entry 'installed)))
+ (if installed
+ (user-error "This output is already installed")
+ (guix-list-mark 'install t))))
+
+(defun guix-output-list-mark-delete ()
+ "Mark the current output for deletion and move to the next line."
+ (interactive)
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-get-key-val entry 'installed)))
+ (if installed
+ (guix-list-mark 'delete t)
+ (user-error "This output is not installed"))))
+
+(defun guix-output-list-mark-upgrade ()
+ "Mark the current output for deletion and move to the next line."
+ (interactive)
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-get-key-val entry 'installed)))
+ (or installed
+ (user-error "This output is not installed"))
+ (when (or (guix-get-key-val entry 'obsolete)
+ (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
+ (guix-list-mark 'upgrade t))))
+
+(defun guix-output-list-mark-upgrades ()
+ "Mark all obsolete package outputs for upgrading."
+ (interactive)
+ (guix-list-mark-package-upgrades
+ (lambda (_) (guix-list-mark 'upgrade))))
+
+(defun guix-output-list-execute ()
+ "Perform actions on the marked outputs."
+ (interactive)
+ (guix-list-execute-package-actions #'guix-output-list-make-action))
+
+(defun guix-output-list-make-action (action-type)
+ "Return action specification for the outputs marked with ACTION-TYPE.
+Return nil, if there are no outputs marked with ACTION-TYPE.
+The specification is suitable for `guix-process-output-actions'."
+ (let ((ids (guix-list-get-marked-id-list action-type)))
+ (and ids (cons action-type
+ (mapcar #'guix-get-package-id-and-output-by-output-id
+ ids)))))
+
+(defun guix-output-list-describe (&optional arg)
+ "Describe outputs or packages marked with a general mark.
+If no entries are marked, describe the current output or package.
+With prefix (if ARG is non-nil), describe entries marked with any mark.
+Also see `guix-output-list-describe-type'."
+ (interactive "P")
+ (if (eq guix-output-list-describe-type 'output)
+ (guix-list-describe arg)
+ (let* ((oids (or (apply #'guix-list-get-marked-id-list
+ (unless arg '(general)))
+ (list (guix-list-current-id))))
+ (pids (mapcar (lambda (oid)
+ (car (guix-get-package-id-and-output-by-output-id
+ oid)))
+ oids)))
+ (guix-list-describe-maybe 'package (cl-remove-duplicates pids)))))
+
+\f
;;; Displaying generations
(guix-define-buffer-type list generation)
(let ((map guix-generation-list-mode-map))
(define-key map (kbd "RET") 'guix-generation-list-show-packages)
- (define-key map (kbd "i") 'guix-generation-list-describe)
+ (define-key map (kbd "i") 'guix-list-describe)
(define-key map (kbd "d") 'guix-generation-list-mark-delete-simple))
(defun guix-generation-list-show-packages ()
"List installed packages for the generation at point."
(interactive)
- (guix-package-list-get-show 'generation (guix-list-current-id)))
+ (guix-get-show-entries 'list guix-package-list-type 'generation
+ (guix-list-current-id)))
(provide 'guix-list)
HCoop / jackhill / guix / guix.git / blobdiff