-;;; 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>
;;; 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)
-(defgroup guix-list nil
- "General settings for list buffers."
- :prefix "guix-list-"
- :group 'guix)
+(guix-define-buffer-type list)
-(defgroup guix-list-faces nil
- "Faces for list buffers."
- :group 'guix-list
- :group 'guix-faces)
+(defface guix-list-file-name
+ '((t :inherit guix-info-file-name))
+ "Face used for file names."
+ :group 'guix-list-faces)
-(defface guix-list-file-path
- '((t :inherit guix-info-file-path))
- "Face used for file paths."
+(defface guix-list-url
+ '((t :inherit guix-info-url))
+ "Face used for URLs."
:group 'guix-list-faces)
(defface guix-list-time
"Face used for time stamps."
:group 'guix-list-faces)
-(defvar guix-list-format
- `((package
- (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))
- (output
- (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))
- (generation
- (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)))
- "List of format values of the displayed columns.
-Each element of the list has a form:
-
- (ENTRY-TYPE . ((PARAM VALUE-FUN WIDTH SORT . PROPS) ...))
-
-PARAM is the name of an entry parameter of ENTRY-TYPE.
-
-VALUE-FUN may be either nil or a function returning a value that
-will be inserted. The function is called with 2 arguments: the
-first one is the value of the parameter; the second one is an
-entry (alist of parameter names and values).
-
-For the meaning of WIDTH, SORT and PROPS, see
-`tabulated-list-format'.")
-
-(defvar guix-list-column-titles
- '((generation
- (number . "N.")))
- "Column titles for list buffers.
-Has the same structure as `guix-param-titles', but titles from
-this list have a priority.")
-
(defun guix-list-describe (&optional mark-names)
"Describe entries marked with a general mark.
'Describe' means display entries in 'info' buffer.
(let* ((ids (or (apply #'guix-list-get-marked-id-list mark-names)
(list (guix-list-current-id))))
(count (length ids))
- (entry-type guix-entry-type))
+ (entry-type (guix-buffer-current-entry-type)))
(when (or (<= count (guix-list-describe-warning-count entry-type))
(y-or-n-p (format "Do you really want to describe %d entries? "
count)))
(guix-list-describe-entries entry-type ids))))
-(defun guix-list-describe-ids (ids)
- "Describe entries with IDS (list of identifiers)."
- (apply #'guix-get-show-entries
- guix-profile 'info guix-entry-type 'id ids))
-
\f
;;; Wrappers for 'list' variables
(defvar guix-list-data nil
"Alist with 'list' data.
-This alist is filled by `guix-list-define-entry-type' macro.")
+This alist is filled by `guix-list-define-interface' macro.")
(defun guix-list-value (entry-type symbol)
"Return SYMBOL's value for ENTRY-TYPE from `guix-list-data'."
(defun guix-list-param-title (entry-type param)
"Return column title of an ENTRY-TYPE parameter PARAM."
- (or (guix-assq-value guix-list-column-titles
- entry-type param)
- (guix-get-param-title entry-type param)))
+ (guix-buffer-param-title 'list entry-type param))
(defun guix-list-format (entry-type)
"Return column format for ENTRY-TYPE."
- (guix-assq-value guix-list-format entry-type))
+ (guix-list-value entry-type 'format))
(defun guix-list-displayed-params (entry-type)
"Return a list of ENTRY-TYPE parameters that should be displayed."
"Return alist of additional marks for ENTRY-TYPE."
(guix-list-value entry-type 'marks))
+(defun guix-list-single-entry? (entry-type)
+ "Return non-nil, if a single entry of ENTRY-TYPE should be listed."
+ (guix-list-value entry-type 'list-single))
+
(defun guix-list-describe-warning-count (entry-type)
"Return the maximum number of ENTRY-TYPE entries to describe."
(guix-list-value entry-type 'describe-count))
(cons (guix-list-param-title entry-type param)
rest-spec))))
-(defun guix-list-insert-entries (entries entry-type)
- "Display ENTRIES of ENTRY-TYPE in the current list buffer.
-ENTRIES should have a form of `guix-entries'."
- (setq tabulated-list-entries
- (guix-list-tabulated-entries entries entry-type))
- (tabulated-list-print))
-
(defun guix-list-tabulated-entries (entries entry-type)
"Return a list of ENTRY-TYPE values for `tabulated-list-entries'."
(mapcar (lambda (entry)
(funcall fun val entry)
(guix-get-string val))))))
+\f
+;;; Displaying entries
+
+(defun guix-list-get-display-entries (entry-type &rest args)
+ "Search for entries and show them in a 'list' buffer preferably."
+ (let ((entries (guix-buffer-get-entries 'list entry-type args)))
+ (if (or (null entries) ; = 0
+ (cdr entries) ; > 1
+ (guix-list-single-entry? entry-type)
+ (null (guix-buffer-value 'info entry-type 'show-entries)))
+ (guix-buffer-display-entries entries 'list entry-type args 'add)
+ (if (equal (guix-buffer-value 'info entry-type 'get-entries)
+ (guix-buffer-value 'list entry-type 'get-entries))
+ (guix-buffer-display-entries entries 'info entry-type args 'add)
+ (guix-buffer-get-display-entries 'info entry-type args 'add)))))
+
+(defun guix-list-insert-entries (entries entry-type)
+ "Print ENTRY-TYPE ENTRIES in the current buffer."
+ (setq tabulated-list-entries
+ (guix-list-tabulated-entries entries entry-type))
+ (tabulated-list-print))
+
(defun guix-list-get-one-line (val &optional _)
"Return one-line string from a multi-line string VAL.
VAL may be nil."
(guix-get-string (guix-get-time-string seconds)
'guix-list-time))
-(defun guix-list-get-file-path (path &optional _)
- "Return PATH button specification for `tabulated-list-entries'."
- (list path
- 'face 'guix-list-file-path
+(defun guix-list-get-file-name (file-name &optional _)
+ "Return FILE-NAME button specification for `tabulated-list-entries'."
+ (list file-name
+ 'face 'guix-list-file-name
'action (lambda (btn) (find-file (button-label btn)))
'follow-link t
'help-echo "Find file"))
+(defun guix-list-get-url (url &optional _)
+ "Return URL button specification for `tabulated-list-entries'."
+ (list url
+ 'face 'guix-list-url
+ 'action (lambda (btn) (browse-url (button-label btn)))
+ 'follow-link t
+ 'help-echo "Browse URL"))
+
+\f
+;;; 'List' lines
+
(defun guix-list-current-id ()
- "Return ID of the current entry."
+ "Return ID of the entry at point."
(or (tabulated-list-get-id)
(user-error "No entry here")))
(defun guix-list-current-entry ()
- "Return alist of the current entry info."
- (guix-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-entry-value (guix-list-current-entry) 'package-id))))
+ "Return entry at point."
+ (guix-entry-by-id (guix-list-current-id)
+ (guix-buffer-current-entries)))
(defun guix-list-for-each-line (fun &rest args)
"Call FUN with ARGS for each entry line."
(guix-list-restore-marks))
\f
+;;; Major mode and interface definer
+
(defvar guix-list-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent
- map (make-composed-keymap guix-root-map
+ map (make-composed-keymap guix-buffer-map
tabulated-list-mode-map))
(define-key map (kbd "RET") 'guix-list-describe)
(define-key map (kbd "i") 'guix-list-describe)
(define-key map (kbd "DEL") 'guix-list-unmark-backward)
(define-key map [remap tabulated-list-sort] 'guix-list-sort)
map)
- "Parent keymap for list buffers.")
+ "Keymap for `guix-list-mode' buffers.")
(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
- "Parent mode for displaying information in list buffers."
- (setq tabulated-list-padding 2))
+ "Parent mode for displaying data in 'list' form.")
+
+(defun guix-list-mode-initialize (entry-type)
+ "Set up the current 'list' buffer for displaying ENTRY-TYPE entries."
+ (setq tabulated-list-padding 2
+ tabulated-list-format (guix-list-tabulated-format entry-type)
+ tabulated-list-sort-key (guix-list-tabulated-sort-key entry-type))
+ (setq-local guix-list-marks (guix-list-marks entry-type))
+ (tabulated-list-init-header))
-(defmacro guix-list-define-entry-type (entry-type &rest args)
- "Define common stuff for displaying ENTRY-TYPE entries in list buffers.
+(defmacro guix-list-define-interface (entry-type &rest args)
+ "Define 'list' interface for displaying ENTRY-TYPE entries.
+Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
-following keywords are available:
+Required keywords:
+
+ - `:format' - default value of the generated
+ `guix-ENTRY-TYPE-list-format' variable.
+
+Optional keywords:
- `:sort-key' - default value of the generated
`guix-ENTRY-TYPE-list-sort-key' variable.
- `:describe-function' - default value of the generated
`guix-ENTRY-TYPE-describe-function' variable.
+ - `:list-single?' - default value of the generated
+ `guix-ENTRY-TYPE-list-single' variable.
+
- `:marks' - default value of the generated
`guix-ENTRY-TYPE-list-marks' variable.
-"
+
+The rest keyword arguments are passed to
+`guix-buffer-define-interface' macro."
+ (declare (indent 1))
(let* ((entry-type-str (symbol-name entry-type))
(prefix (concat "guix-" entry-type-str "-list"))
(group (intern prefix))
- (mode-str (concat prefix "-mode"))
- (init-fun (intern (concat prefix "-mode-initialize")))
(describe-var (intern (concat prefix "-describe-function")))
(describe-count-var (intern (concat prefix
"-describe-warning-count")))
+ (format-var (intern (concat prefix "-format")))
(sort-key-var (intern (concat prefix "-sort-key")))
+ (list-single-var (intern (concat prefix "-single")))
(marks-var (intern (concat prefix "-marks"))))
(guix-keyword-args-let args
- ((describe-val :describe-function)
+ ((show-entries-val :show-entries-function)
+ (describe-val :describe-function)
(describe-count-val :describe-count 10)
+ (format-val :format)
(sort-key-val :sort-key)
+ (list-single-val :list-single?)
(marks-val :marks))
`(progn
+ (defcustom ,format-var ,format-val
+ ,(format "\
+List of format values of the displayed columns.
+Each element of the list has a form:
+
+ (PARAM VALUE-FUN WIDTH SORT . PROPS)
+
+PARAM is a name of '%s' entry parameter.
+
+VALUE-FUN may be either nil or a function returning a value that
+will be inserted. The function is called with 2 arguments: the
+first one is the value of the parameter; the second one is an
+entry (alist of parameter names and values).
+
+For the meaning of WIDTH, SORT and PROPS, see
+`tabulated-list-format'."
+ entry-type-str)
+ :type 'sexp
+ :group ',group)
+
(defcustom ,sort-key-var ,sort-key-val
,(format "\
Default sort key for 'list' buffer with '%s' entries.
Marks from this list are used along with `guix-list-default-marks'."
entry-type-str))
+ (defcustom ,list-single-var ,list-single-val
+ ,(format "\
+If non-nil, list '%s' entry even if it is the only matching result.
+If nil, show a single '%s' entry in the 'info' buffer."
+ entry-type-str entry-type-str)
+ :type 'boolean
+ :group ',group)
+
(defcustom ,describe-count-var ,describe-count-val
,(format "\
The maximum number of '%s' entries to describe without a warning.
,(format "Function used to describe '%s' entries."
entry-type-str))
- (defun ,init-fun ()
- ,(concat "Initial settings for `" mode-str "'.")
- (setq tabulated-list-sort-key (guix-list-tabulated-sort-key
- ',entry-type)
- tabulated-list-format (guix-list-tabulated-format
- ',entry-type))
- (setq-local guix-list-marks (guix-list-marks ',entry-type))
- (tabulated-list-init-header))
-
(guix-alist-put!
'((describe . ,describe-var)
(describe-count . ,describe-count-var)
+ (format . ,format-var)
(sort-key . ,sort-key-var)
+ (list-single . ,list-single-var)
(marks . ,marks-var))
- 'guix-list-data ',entry-type)))))
-
-(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
-
-(defun guix-list-edit-package ()
- "Go to the location of the current package."
- (interactive)
- (guix-edit (guix-list-current-package-id)))
+ 'guix-list-data ',entry-type)
+
+ ,(if show-entries-val
+ `(guix-buffer-define-interface list ,entry-type
+ :show-entries-function ,show-entries-val
+ ,@%foreign-args)
+
+ (let ((insert-fun (intern (concat prefix "-insert-entries")))
+ (mode-init-fun (intern (concat prefix "-mode-initialize"))))
+ `(progn
+ (defun ,insert-fun (entries)
+ ,(format "\
+Print '%s' ENTRIES in the current 'list' buffer."
+ entry-type-str)
+ (guix-list-insert-entries entries ',entry-type))
+
+ (defun ,mode-init-fun ()
+ ,(format "\
+Set up the current 'list' buffer for displaying '%s' entries."
+ entry-type-str)
+ (guix-list-mode-initialize ',entry-type))
+
+ (guix-buffer-define-interface list ,entry-type
+ :insert-entries-function ',insert-fun
+ :mode-init-function ',mode-init-fun
+ ,@%foreign-args))))))))
\f
-;;; Displaying packages
-
-(guix-define-buffer-type list package)
-
-(guix-list-define-entry-type package
- :describe-function 'guix-list-describe-ids
- :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-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)
- (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-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-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-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))))
-
-\f
-;;; Displaying outputs
-
-(guix-define-buffer-type list output
- :buffer-name "*Guix Package List*"
- :required (package-id))
-
-(guix-list-define-entry-type output
- :describe-function 'guix-output-list-describe
- :sort-key '(name)
- :marks '((install . ?I)
- (upgrade . ?U)
- (delete . ?D)))
-
-(let ((map guix-output-list-mode-map))
- (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)
- (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))))
+(defvar guix-list-font-lock-keywords
+ (eval-when-compile
+ `((,(rx "(" (group "guix-list-define-interface")
+ symbol-end)
+ . 1))))
-(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)
- (apply #'guix-get-show-entries
- guix-profile 'info 'output 'id ids)
- (let ((pids (mapcar (lambda (oid)
- (car (guix-package-id-and-output-by-output-id
- oid)))
- ids)))
- (apply #'guix-get-show-entries
- guix-profile 'info 'package 'id
- (cl-remove-duplicates pids)))))
-
-\f
-;;; Displaying generations
-
-(guix-define-buffer-type list generation)
-
-(guix-list-define-entry-type generation
- :describe-function 'guix-list-describe-ids
- :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-profile number (current-buffer)))))
-
-(defun guix-generation-list-show-packages ()
- "List installed packages for the generation at point."
- (interactive)
- (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.
-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-profile marked (current-buffer))))
+(font-lock-add-keywords 'emacs-lisp-mode guix-list-font-lock-keywords)
(provide 'guix-list)
HCoop / jackhill / guix / guix.git / blobdiff