emacs: Add support for displaying outputs.
Suggested by Taylan Ulrich Bayirli/Kammer and Ludovic Courtès. * emacs/guix-base.el (guix-param-titles): Add output titles. (guix-messages): Add output messages. (guix-get-package-id-and-output-by-output-id): New procedure. (guix-define-buffer-type): Add ':buffer-name' key. * emacs/guix-info.el: Add "output-info" buffer type. (guix-info-insert-methods): Add output methods. (guix-info-displayed-params): Add output params. (guix-output-info-insert-version, guix-output-info-insert-output): New procedures. * emacs/guix-list.el: Add "output-list" buffer type. (guix-list-column-format): Add output formats. (guix-list-column-value-methods): Add output methods. (guix-package-list-type): New variable. (guix-generation-list-show-packages): Use it. (guix-package-list-marking-check): Use 'guix-output-list-mode'. (guix-list-mark-package-upgrades): New procedure. (guix-package-list-mark-upgrades): Use it. (guix-list-execute-package-actions): New procedure. (guix-package-list-execute): Use it. (guix-list-describe-maybe): New procedure. (guix-list-describe): Use it. (guix-output-list-mark-install, guix-output-list-mark-delete, guix-output-list-mark-upgrade, guix-output-list-mark-upgrades, guix-output-list-execute, guix-output-list-make-action, guix-output-list-describe): New procedures. (guix-output-list-describe-type): New variable. * emacs/guix.el (guix-get-show-packages): Use 'guix-package-list-type'. * doc/emacs.texi (emacs Commands): Mention 'guix-package-list-type'. (emacs List buffer): Adjust accordingly. (emacs Info buffer): Likewise. (emacs Buffer Names): New node. (emacs Keymaps): Add keymaps for output buffers.
This commit is contained in:
		
							parent
							
								
									81b339fe31
								
							
						
					
					
						commit
						a54a237b5f
					
				
					 5 changed files with 331 additions and 43 deletions
				
			
		|  | @ -104,6 +104,14 @@ many last generations. | ||||||
| 
 | 
 | ||||||
| @end table | @end table | ||||||
| 
 | 
 | ||||||
|  | By default commands for displaying packages display each output on a | ||||||
|  | separate line.  If you prefer to see a list of packages (i.e.@: a list | ||||||
|  | with a package per line), use the following setting: | ||||||
|  | 
 | ||||||
|  | @example | ||||||
|  | (setq guix-package-list-type 'package) | ||||||
|  | @end example | ||||||
|  | 
 | ||||||
| It is possible to change the currently used profile with | It is possible to change the currently used profile with | ||||||
| @kbd{M-x@tie{}guix-set-current-profile}.  This has the same effect as | @kbd{M-x@tie{}guix-set-current-profile}.  This has the same effect as | ||||||
| specifying @code{--profile} option for @command{guix package} | specifying @code{--profile} option for @command{guix package} | ||||||
|  | @ -177,18 +185,15 @@ A ``package-list'' buffer additionally provides the following bindings: | ||||||
| Describe marked packages (display available information in a | Describe marked packages (display available information in a | ||||||
| ``package-info'' buffer). | ``package-info'' buffer). | ||||||
| @item i | @item i | ||||||
| Mark "out" of the current package for installation (with prefix, prompt | Mark the current package for installation. | ||||||
| for output(s) to install). |  | ||||||
| @item d | @item d | ||||||
| Mark all installed outputs of the current package for deletion (with | Mark the current package for deletion. | ||||||
| prefix, prompt for output(s) to delete). |  | ||||||
| @item U | @item U | ||||||
| Mark all installed outputs of the current package for upgrading (with | Mark the current package for upgrading. | ||||||
| prefix, prompt for output(s) to upgrade). |  | ||||||
| @item ^ | @item ^ | ||||||
| Mark all obsolete packages for upgrading. | Mark all obsolete packages for upgrading. | ||||||
| @item x | @item x | ||||||
| Execute actions on marked packages. | Execute actions on the marked packages. | ||||||
| @end table | @end table | ||||||
| 
 | 
 | ||||||
| A ``generation-list'' buffer additionally provides the following | A ``generation-list'' buffer additionally provides the following | ||||||
|  | @ -244,6 +249,7 @@ all) and faces. | ||||||
| 
 | 
 | ||||||
| @menu | @menu | ||||||
| * Guile and Build Options: emacs Build Options.	Specifying how packages are built. | * Guile and Build Options: emacs Build Options.	Specifying how packages are built. | ||||||
|  | * Buffer Names: emacs Buffer Names.	Names of Guix buffers. | ||||||
| * Keymaps: emacs Keymaps.		Configuring key bindings. | * Keymaps: emacs Keymaps.		Configuring key bindings. | ||||||
| * Appearance: emacs Appearance.		Settings for visual appearance. | * Appearance: emacs Appearance.		Settings for visual appearance. | ||||||
| @end menu | @end menu | ||||||
|  | @ -270,6 +276,39 @@ build}). | ||||||
| 
 | 
 | ||||||
| @end table | @end table | ||||||
| 
 | 
 | ||||||
|  | @node emacs Buffer Names | ||||||
|  | @subsubsection Buffer Names | ||||||
|  | 
 | ||||||
|  | Default names of ``guix.el'' buffers (``*Guix@tie{}@dots{}*'') may be | ||||||
|  | changed with the following variables: | ||||||
|  | 
 | ||||||
|  | @table @code | ||||||
|  | @item guix-package-list-buffer-name | ||||||
|  | @item guix-output-list-buffer-name | ||||||
|  | @item guix-generation-list-buffer-name | ||||||
|  | @item guix-package-info-buffer-name | ||||||
|  | @item guix-output-info-buffer-name | ||||||
|  | @item guix-generation-info-buffer-name | ||||||
|  | @item guix-repl-buffer-name | ||||||
|  | @item guix-internal-repl-buffer-name | ||||||
|  | @item guix-temp-buffer-name | ||||||
|  | @end table | ||||||
|  | 
 | ||||||
|  | For example if you want to display all types of results in a single | ||||||
|  | buffer (in such case you will probably use a history (@kbd{l}/@kbd{r}) | ||||||
|  | extensively), you may do it like this: | ||||||
|  | 
 | ||||||
|  | @example | ||||||
|  | (let ((name "Guix Universal")) | ||||||
|  |   (setq | ||||||
|  |    guix-package-list-buffer-name    name | ||||||
|  |    guix-output-list-buffer-name     name | ||||||
|  |    guix-generation-list-buffer-name name | ||||||
|  |    guix-package-info-buffer-name    name | ||||||
|  |    guix-output-info-buffer-name     name | ||||||
|  |    guix-generation-info-buffer-name name)) | ||||||
|  | @end example | ||||||
|  | 
 | ||||||
| @node emacs Keymaps | @node emacs Keymaps | ||||||
| @subsubsection Keymaps | @subsubsection Keymaps | ||||||
| 
 | 
 | ||||||
|  | @ -283,6 +322,9 @@ Parent keymap with general keys for ``list'' buffers. | ||||||
| @item guix-package-list-mode-map | @item guix-package-list-mode-map | ||||||
| Keymap with specific keys for ``package-list'' buffers. | Keymap with specific keys for ``package-list'' buffers. | ||||||
| 
 | 
 | ||||||
|  | @item guix-output-list-mode-map | ||||||
|  | Keymap with specific keys for ``output-list'' buffers. | ||||||
|  | 
 | ||||||
| @item guix-generation-list-mode-map | @item guix-generation-list-mode-map | ||||||
| Keymap with specific keys for ``generation-list'' buffers. | Keymap with specific keys for ``generation-list'' buffers. | ||||||
| 
 | 
 | ||||||
|  | @ -292,6 +334,9 @@ Parent keymap with general keys for ``info'' buffers. | ||||||
| @item guix-package-info-mode-map | @item guix-package-info-mode-map | ||||||
| Keymap with specific keys for ``package-info'' buffers. | Keymap with specific keys for ``package-info'' buffers. | ||||||
| 
 | 
 | ||||||
|  | @item guix-output-info-mode-map | ||||||
|  | Keymap with specific keys for ``output-info'' buffers. | ||||||
|  | 
 | ||||||
| @item guix-generation-info-mode-map | @item guix-generation-info-mode-map | ||||||
| Keymap with specific keys for ``generation-info'' buffers. | Keymap with specific keys for ``generation-info'' buffers. | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -87,6 +87,22 @@ Interactively, prompt for PATH.  With prefix, use | ||||||
|      (path              . "Installed path") |      (path              . "Installed path") | ||||||
|      (dependencies      . "Dependencies") |      (dependencies      . "Dependencies") | ||||||
|      (output            . "Output")) |      (output            . "Output")) | ||||||
|  |     (output | ||||||
|  |      (id                . "ID") | ||||||
|  |      (name              . "Name") | ||||||
|  |      (version           . "Version") | ||||||
|  |      (license           . "License") | ||||||
|  |      (synopsis          . "Synopsis") | ||||||
|  |      (description       . "Description") | ||||||
|  |      (home-url          . "Home page") | ||||||
|  |      (output            . "Output") | ||||||
|  |      (inputs            . "Inputs") | ||||||
|  |      (native-inputs     . "Native inputs") | ||||||
|  |      (propagated-inputs . "Propagated inputs") | ||||||
|  |      (location          . "Location") | ||||||
|  |      (installed         . "Installed") | ||||||
|  |      (path              . "Installed path") | ||||||
|  |      (dependencies      . "Dependencies")) | ||||||
|     (generation |     (generation | ||||||
|      (id                . "ID") |      (id                . "ID") | ||||||
|      (number            . "Number") |      (number            . "Number") | ||||||
|  | @ -130,6 +146,14 @@ Each element of the list has a form: | ||||||
|                 (equal id (guix-get-key-val entry 'id))) |                 (equal id (guix-get-key-val entry 'id))) | ||||||
|               entries)) |               entries)) | ||||||
| 
 | 
 | ||||||
|  | (defun guix-get-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 the packages | ||||||
| 
 | 
 | ||||||
|  | @ -227,6 +251,9 @@ The following stuff should be defined outside this macro: | ||||||
| Remaining argument (ARGS) should have a form [KEYWORD VALUE] ...  The | Remaining argument (ARGS) should have a form [KEYWORD VALUE] ...  The | ||||||
| following keywords are available: | following keywords are available: | ||||||
| 
 | 
 | ||||||
|  |   - `:buffer-name' - default value for the defined | ||||||
|  |     `guix-TYPE-buffer-name' variable. | ||||||
|  | 
 | ||||||
|   - `:required' - default value for the defined |   - `:required' - default value for the defined | ||||||
|     `guix-TYPE-required-params' variable. |     `guix-TYPE-required-params' variable. | ||||||
| 
 | 
 | ||||||
|  | @ -252,6 +279,7 @@ following keywords are available: | ||||||
|          (revert-var     (intern (concat prefix "-revert-no-confirm"))) |          (revert-var     (intern (concat prefix "-revert-no-confirm"))) | ||||||
|          (history-var    (intern (concat prefix "-history-size"))) |          (history-var    (intern (concat prefix "-history-size"))) | ||||||
|          (params-var     (intern (concat prefix "-required-params"))) |          (params-var     (intern (concat prefix "-required-params"))) | ||||||
|  |          (buf-name-val   (format "*Guix %s %s*" Entry-type-str Buf-type-str)) | ||||||
|          (revert-val     nil) |          (revert-val     nil) | ||||||
|          (history-val    20) |          (history-val    20) | ||||||
|          (params-val     '(id))) |          (params-val     '(id))) | ||||||
|  | @ -262,6 +290,7 @@ following keywords are available: | ||||||
| 	(`:required     (setq params-val (pop args))) | 	(`:required     (setq params-val (pop args))) | ||||||
| 	(`:history-size (setq history-val (pop args))) | 	(`:history-size (setq history-val (pop args))) | ||||||
| 	(`:revert       (setq revert-val (pop args))) | 	(`:revert       (setq revert-val (pop args))) | ||||||
|  |         (`:buffer-name  (setq buf-name-val (pop args))) | ||||||
| 	(_ (pop args)))) | 	(_ (pop args)))) | ||||||
| 
 | 
 | ||||||
|     `(progn |     `(progn | ||||||
|  | @ -270,8 +299,7 @@ following keywords are available: | ||||||
|          :prefix ,(concat prefix "-") |          :prefix ,(concat prefix "-") | ||||||
|          :group ',(intern (concat "guix-" buf-type-str))) |          :group ',(intern (concat "guix-" buf-type-str))) | ||||||
| 
 | 
 | ||||||
|        (defcustom ,buf-name-var ,(format "*Guix %s %s*" |        (defcustom ,buf-name-var ,buf-name-val | ||||||
|                                          Entry-type-str Buf-type-str) |  | ||||||
|          ,(concat "Default name of the " buf-str " for displaying " entry-str ".") |          ,(concat "Default name of the " buf-str " for displaying " entry-str ".") | ||||||
|          :type 'string |          :type 'string | ||||||
|          :group ',group) |          :group ',group) | ||||||
|  | @ -470,8 +498,8 @@ This function will not update the information, use | ||||||
|       (many "%d newest available packages." count)) |       (many "%d newest available packages." count)) | ||||||
|      (installed |      (installed | ||||||
|       (0 "No installed packages.") |       (0 "No installed packages.") | ||||||
|       (1 "A single installed package.") |       (1 "A single package installed.") | ||||||
|       (many "%d installed packages." count)) |       (many "%d packages installed." count)) | ||||||
|      (obsolete |      (obsolete | ||||||
|       (0 "No obsolete packages.") |       (0 "No obsolete packages.") | ||||||
|       (1 "A single obsolete package.") |       (1 "A single obsolete package.") | ||||||
|  | @ -480,6 +508,39 @@ This function will not update the information, use | ||||||
|       (0 "No packages installed in generation %d." val) |       (0 "No packages installed in generation %d." val) | ||||||
|       (1 "A single package installed in generation %d." val) |       (1 "A single package installed in generation %d." val) | ||||||
|       (many "%d packages installed in generation %d." count val))) |       (many "%d packages installed in generation %d." count val))) | ||||||
|  |     (output | ||||||
|  |      (id | ||||||
|  |       (0 "Package outputs not found.") | ||||||
|  |       (1 "") | ||||||
|  |       (many "%d package outputs." count)) | ||||||
|  |      (name | ||||||
|  |       (0 "The package output '%s' not found." val) | ||||||
|  |       (1 "A single package output with name '%s'." val) | ||||||
|  |       (many "%d package outputs with '%s' name." count val)) | ||||||
|  |      (regexp | ||||||
|  |       (0 "No package outputs matching '%s'." val) | ||||||
|  |       (1 "A single package output matching '%s'." val) | ||||||
|  |       (many "%d package outputs matching '%s'." count val)) | ||||||
|  |      (all-available | ||||||
|  |       (0 "No package outputs are available for some reason.") | ||||||
|  |       (1 "A single available package output (that's strange).") | ||||||
|  |       (many "%d available package outputs." count)) | ||||||
|  |      (newest-available | ||||||
|  |       (0 "No package outputs are available for some reason.") | ||||||
|  |       (1 "A single newest available package output (that's strange).") | ||||||
|  |       (many "%d newest available package outputs." count)) | ||||||
|  |      (installed | ||||||
|  |       (0 "No installed package outputs.") | ||||||
|  |       (1 "A single package output installed.") | ||||||
|  |       (many "%d package outputs installed." count)) | ||||||
|  |      (obsolete | ||||||
|  |       (0 "No obsolete package outputs.") | ||||||
|  |       (1 "A single obsolete package output.") | ||||||
|  |       (many "%d obsolete package outputs." count)) | ||||||
|  |      (generation | ||||||
|  |       (0 "No package outputs installed in generation %d." val) | ||||||
|  |       (1 "A single package output installed in generation %d." val) | ||||||
|  |       (many "%d package outputs installed in generation %d." count val))) | ||||||
|     (generation |     (generation | ||||||
|      (id |      (id | ||||||
|       (0 "Generations not found.") |       (0 "Generations not found.") | ||||||
|  |  | ||||||
|  | @ -117,6 +117,23 @@ number of characters, it will be split into several lines.") | ||||||
|                         guix-info-insert-title-simple) |                         guix-info-insert-title-simple) | ||||||
|      (dependencies      guix-package-info-insert-output-dependencies |      (dependencies      guix-package-info-insert-output-dependencies | ||||||
|                         guix-info-insert-title-simple)) |                         guix-info-insert-title-simple)) | ||||||
|  |     (output | ||||||
|  |      (name              guix-package-info-name) | ||||||
|  |      (version           guix-output-info-insert-version) | ||||||
|  |      (output            guix-output-info-insert-output) | ||||||
|  |      (path              guix-package-info-insert-output-path | ||||||
|  |                         guix-info-insert-title-simple) | ||||||
|  |      (dependencies      guix-package-info-insert-output-dependencies | ||||||
|  |                         guix-info-insert-title-simple) | ||||||
|  |      (license           guix-package-info-license) | ||||||
|  |      (synopsis          guix-package-info-synopsis) | ||||||
|  |      (description       guix-package-info-insert-description | ||||||
|  |                         guix-info-insert-title-simple) | ||||||
|  |      (home-url          guix-info-insert-url) | ||||||
|  |      (inputs            guix-package-info-insert-inputs) | ||||||
|  |      (native-inputs     guix-package-info-insert-native-inputs) | ||||||
|  |      (propagated-inputs guix-package-info-insert-propagated-inputs) | ||||||
|  |      (location          guix-package-info-insert-location)) | ||||||
|     (generation |     (generation | ||||||
|      (number            guix-generation-info-insert-number) |      (number            guix-generation-info-insert-number) | ||||||
|      (path              guix-info-insert-file-path) |      (path              guix-info-insert-file-path) | ||||||
|  | @ -141,6 +158,8 @@ argument.") | ||||||
| (defvar guix-info-displayed-params | (defvar guix-info-displayed-params | ||||||
|   '((package name version synopsis outputs location home-url |   '((package name version synopsis outputs location home-url | ||||||
|              license inputs native-inputs propagated-inputs description) |              license inputs native-inputs propagated-inputs description) | ||||||
|  |     (output name version output synopsis path dependencies location home-url | ||||||
|  |             license inputs native-inputs propagated-inputs description) | ||||||
|     (installed path dependencies) |     (installed path dependencies) | ||||||
|     (generation number prev-number time path)) |     (generation number prev-number time path)) | ||||||
|   "List of displayed entry parameters. |   "List of displayed entry parameters. | ||||||
|  | @ -520,9 +539,38 @@ ENTRY is an alist with package info." | ||||||
|   "Insert PATH of the installed output." |   "Insert PATH of the installed output." | ||||||
|   (guix-info-insert-val-simple path #'guix-info-insert-file-path)) |   (guix-info-insert-val-simple path #'guix-info-insert-file-path)) | ||||||
| 
 | 
 | ||||||
| (defun guix-package-info-insert-output-dependencies (deps &optional _) | (defalias 'guix-package-info-insert-output-dependencies | ||||||
|   "Insert dependencies DEPS of the installed output." |   'guix-package-info-insert-output-path) | ||||||
|   (guix-info-insert-val-simple deps #'guix-info-insert-file-path)) | 
 | ||||||
|  |  | ||||||
|  | ;;; Displaying outputs | ||||||
|  | 
 | ||||||
|  | (guix-define-buffer-type info output | ||||||
|  |   :buffer-name "*Guix Package Info*" | ||||||
|  |   :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-val-default version | ||||||
|  |                                 'guix-package-info-version) | ||||||
|  |   (and (guix-get-key-val 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-get-key-val entry 'installed)) | ||||||
|  |          (obsolete  (guix-get-key-val entry 'obsolete)) | ||||||
|  |          (action-type (if installed 'delete 'install))) | ||||||
|  |     (guix-info-insert-val-default | ||||||
|  |      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 | ;;; Displaying generations | ||||||
|  |  | ||||||
|  | @ -55,6 +55,12 @@ entries, he will be prompted for confirmation." | ||||||
|      (outputs 13 t) |      (outputs 13 t) | ||||||
|      (installed 13 t) |      (installed 13 t) | ||||||
|      (synopsis 30 nil)) |      (synopsis 30 nil)) | ||||||
|  |     (output | ||||||
|  |      (name 20 t) | ||||||
|  |      (version 10 nil) | ||||||
|  |      (output 9 t) | ||||||
|  |      (installed 12 t) | ||||||
|  |      (synopsis 30 nil)) | ||||||
|     (generation |     (generation | ||||||
|      (number 5 |      (number 5 | ||||||
|              ,(lambda (a b) (guix-list-sort-numerically 0 a b)) |              ,(lambda (a b) (guix-list-sort-numerically 0 a b)) | ||||||
|  | @ -82,6 +88,10 @@ this list have a priority.") | ||||||
|      (synopsis    . guix-list-get-one-line) |      (synopsis    . guix-list-get-one-line) | ||||||
|      (description . guix-list-get-one-line) |      (description . guix-list-get-one-line) | ||||||
|      (installed   . guix-package-list-get-installed-outputs)) |      (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 |     (generation | ||||||
|      (time . guix-list-get-time) |      (time . guix-list-get-time) | ||||||
|      (path . guix-list-get-file-path))) |      (path . guix-list-get-file-path))) | ||||||
|  | @ -420,20 +430,23 @@ This macro defines the following functions: | ||||||
| 
 | 
 | ||||||
| (put 'guix-list-define-entry-type 'lisp-indent-function 'defun) | (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) | (defun guix-list-describe (&optional arg) | ||||||
|   "Describe entries marked with a general mark. |   "Describe entries marked with a general mark. | ||||||
| If no entries are marked, describe the current entry. | If no entries are marked, describe the current entry. | ||||||
| With prefix (if ARG is non-nil), describe entries marked with any mark." | With prefix (if ARG is non-nil), describe entries marked with any mark." | ||||||
|   (interactive "P") |   (interactive "P") | ||||||
|   (let* ((ids (or (apply #'guix-list-get-marked-id-list |   (let ((ids (or (apply #'guix-list-get-marked-id-list | ||||||
|                         (unless arg '(general))) |                         (unless arg '(general))) | ||||||
|                   (list (guix-list-current-id)))) |                  (list (guix-list-current-id))))) | ||||||
|          (count (length ids))) |     (guix-list-describe-maybe guix-entry-type 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 guix-entry-type 'id ids)))) |  | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
| ;;; Displaying packages | ;;; Displaying packages | ||||||
|  | @ -456,6 +469,15 @@ With prefix (if ARG is non-nil), describe entries marked with any mark." | ||||||
|   "Face used if a package is obsolete." |   "Face used if a package is obsolete." | ||||||
|   :group 'guix-package-list) |   :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 | (defcustom guix-package-list-generation-marking-enabled nil | ||||||
|   "If non-nil, allow putting marks in a list with 'generation packages'. |   "If non-nil, allow putting marks in a list with 'generation packages'. | ||||||
| 
 | 
 | ||||||
|  | @ -499,7 +521,8 @@ Colorize it with `guix-package-list-installed' or | ||||||
| (defun guix-package-list-marking-check () | (defun guix-package-list-marking-check () | ||||||
|   "Signal an error if marking is disabled for the current buffer." |   "Signal an error if marking is disabled for the current buffer." | ||||||
|   (when (and (not guix-package-list-generation-marking-enabled) |   (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)) |              (eq guix-search-type 'generation)) | ||||||
|     (error "Action marks are disabled for lists of 'generation packages'"))) |     (error "Action marks are disabled for lists of 'generation packages'"))) | ||||||
| 
 | 
 | ||||||
|  | @ -563,9 +586,10 @@ be separated with \",\")." | ||||||
|        (and arg "Output(s) to upgrade: ") |        (and arg "Output(s) to upgrade: ") | ||||||
|        installed)))) |        installed)))) | ||||||
| 
 | 
 | ||||||
| (defun guix-package-list-mark-upgrades () | (defun guix-list-mark-package-upgrades (fun) | ||||||
|   "Mark all obsolete packages for upgrading." |   "Mark all obsolete packages for upgrading. | ||||||
|   (interactive) | Use FUN to perform marking of the current line.  FUN should | ||||||
|  | accept an entry as argument." | ||||||
|   (guix-package-list-marking-check) |   (guix-package-list-marking-check) | ||||||
|   (let ((obsolete (cl-remove-if-not |   (let ((obsolete (cl-remove-if-not | ||||||
|                    (lambda (entry) |                    (lambda (entry) | ||||||
|  | @ -579,19 +603,31 @@ be separated with \",\")." | ||||||
|                         (equal id (guix-get-key-val entry 'id))) |                         (equal id (guix-get-key-val entry 'id))) | ||||||
|                       obsolete))) |                       obsolete))) | ||||||
|          (when entry |          (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 |      (apply #'guix-list-mark | ||||||
|             'upgrade nil |             'upgrade nil | ||||||
|                   (guix-get-installed-outputs entry)))))))) |             (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 fun '(install delete upgrade))))) | ||||||
|  |     (if actions | ||||||
|  |         (apply #'guix-process-package-actions actions) | ||||||
|  |       (user-error "No operations specified")))) | ||||||
| 
 | 
 | ||||||
| (defun guix-package-list-execute () | (defun guix-package-list-execute () | ||||||
|   "Perform actions on the marked packages." |   "Perform actions on the marked packages." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((actions (delq nil |   (guix-list-execute-package-actions #'guix-package-list-make-action)) | ||||||
|                        (mapcar #'guix-package-list-make-action |  | ||||||
|                                '(install delete upgrade))))) |  | ||||||
|     (if actions |  | ||||||
|         (apply #'guix-process-package-actions actions) |  | ||||||
|       (user-error "No operations specified")))) |  | ||||||
| 
 | 
 | ||||||
| (defun guix-package-list-make-action (action-type) | (defun guix-package-list-make-action (action-type) | ||||||
|   "Return action specification for the packages marked with ACTION-TYPE. |   "Return action specification for the packages marked with ACTION-TYPE. | ||||||
|  | @ -600,6 +636,104 @@ The specification is suitable for `guix-process-package-actions'." | ||||||
|   (let ((specs (guix-list-get-marked-args action-type))) |   (let ((specs (guix-list-get-marked-args action-type))) | ||||||
|     (and specs (cons action-type specs)))) |     (and specs (cons action-type specs)))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | ;;; 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))))) | ||||||
|  | 
 | ||||||
|  |  | ||||||
| ;;; Displaying generations | ;;; Displaying generations | ||||||
| 
 | 
 | ||||||
|  | @ -618,7 +752,7 @@ The specification is suitable for `guix-process-package-actions'." | ||||||
| (defun guix-generation-list-show-packages () | (defun guix-generation-list-show-packages () | ||||||
|   "List installed packages for the generation at point." |   "List installed packages for the generation at point." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (guix-get-show-entries 'list 'package 'generation |   (guix-get-show-entries 'list guix-package-list-type 'generation | ||||||
|                          (guix-list-current-id))) |                          (guix-list-current-id))) | ||||||
| 
 | 
 | ||||||
| (provide 'guix-list) | (provide 'guix-list) | ||||||
|  |  | ||||||
|  | @ -58,24 +58,24 @@ SEARCH-VALS. | ||||||
| Results are displayed in the list buffer, unless a single package | Results are displayed in the list buffer, unless a single package | ||||||
| is found and `guix-list-single-package' is nil." | is found and `guix-list-single-package' is nil." | ||||||
|   (let* ((list-params (guix-get-params-for-receiving |   (let* ((list-params (guix-get-params-for-receiving | ||||||
|                        'list 'package)) |                        'list guix-package-list-type)) | ||||||
|          (packages (guix-get-entries 'package |          (packages (guix-get-entries guix-package-list-type | ||||||
|                                      search-type search-vals |                                      search-type search-vals | ||||||
|                                      list-params))) |                                      list-params))) | ||||||
|     (if (or guix-list-single-package |     (if (or guix-list-single-package | ||||||
|             (cdr packages)) |             (cdr packages)) | ||||||
|         (guix-set-buffer packages 'list 'package |         (guix-set-buffer packages 'list guix-package-list-type | ||||||
|                          search-type search-vals) |                          search-type search-vals) | ||||||
|       (let* ((info-params (guix-get-params-for-receiving |       (let* ((info-params (guix-get-params-for-receiving | ||||||
|                            'info 'package)) |                            'info guix-package-list-type)) | ||||||
|              (packages (if (equal list-params info-params) |              (packages (if (equal list-params info-params) | ||||||
|                            packages |                            packages | ||||||
|                          ;; If we don't have required info, we should |                          ;; If we don't have required info, we should | ||||||
|                          ;; receive it again |                          ;; receive it again | ||||||
|                          (guix-get-entries 'package |                          (guix-get-entries guix-package-list-type | ||||||
|                                            search-type search-vals |                                            search-type search-vals | ||||||
|                                            info-params)))) |                                            info-params)))) | ||||||
|         (guix-set-buffer packages 'info 'package |         (guix-set-buffer packages 'info guix-package-list-type | ||||||
|                          search-type search-vals))))) |                          search-type search-vals))))) | ||||||
| 
 | 
 | ||||||
| (defun guix-get-show-generations (search-type &rest search-vals) | (defun guix-get-show-generations (search-type &rest search-vals) | ||||||
|  |  | ||||||
		Reference in a new issue