From: Alex Kost <alezost@gmail.com>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: guix-devel@gnu.org
Subject: Re: guix.el & multiple outputs
Date: Fri, 19 Sep 2014 10:58:33 +0400 [thread overview]
Message-ID: <87sijodrl2.fsf@gmail.com> (raw)
In-Reply-To: <87bnqssbc0.fsf_-_@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\?\= \=\?utf-8\?Q\?\=22's\?\= message of "Sat, 06 Sep 2014 23:11:59 +0200")
[-- Attachment #1: Type: text/plain, Size: 2095 bytes --]
Ludovic Courtès (2014-09-07 01:11 +0400) wrote:
> Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com> skribis:
>
>> By the way, it might be nice to have an option to list the secondary
>> outputs of a package explicitly alongside the normal, as if it were just
>> another package.
>
> Currently *Guix Package List* shows, for instance:
>
> gcc-toolchain 4.9.1 out, debug debug, out Complete GCC tool chain for C/C++ development
>
> Are you suggesting that it should instead show it as two lines?
>
> gcc-toolchain 4.9.1 out yes Complete GCC tool chain for C/C++ development
> gcc-toolchain 4.9.1 debug yes Complete GCC tool chain for C/C++ development
>
> I think I would prefer it. (One advantage is that it would allow users
> to mark just one specific output, which is not currently possible.)
Hello,
I have made some changes to make that possible. Also I would like to
push 2 more commits (the patches attached) with huge but internal
changes. “guix-main.scm” is mostly rewritten (so the commit message is
big and ugly). Now it looks purely functional for me (I finally removed
‘set-current-manifest-maybe!’).
As for the changes visible to a user: now it is possible to get a list
of outputs with “(setq guix-package-list-type 'output)”. Should it be
default?
Another UI question: RET in “*Guix Package List*” buffer describes
current package(s) in “*Guix Package Info*” buffer. Analogously, RET in
“*Guix Output List*” buffer describes current output(s) in “*Guix Output
Info*” buffer. However I think it's not very useful: “output-info”
buffer is very similar to “package-info” but it contains only one output
per package info. So I think it would be better to display a usual
“package-info” buffer (with all available outputs for a package) when a
user press RET in a list of outputs. [not a clear description, isn't it :-)]
WDYT?
As always I'm not sure in the quality of the commit messages.
Thanks for your patience :)
[-- Attachment #2: 0001-emacs-Use-general-functions-instead-of-generated-one.patch --]
[-- Type: text/x-diff, Size: 26011 bytes --]
From 8154b7193e3dac02447d5f7096b92fb4b9d65ed0 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 17 Sep 2014 17:52:08 +0400
Subject: [PATCH 1/3] emacs: Use general functions instead of generated ones.
* emacs/guix-base.el: Add and use general functions instead of
specialized functions generated by 'guix-define-buffer-type' macro.
(guix-buffer-type, guix-entry-type): New variables.
(guix-set-vars): Add new variables.
(guix-get-show-entries, guix-show-entries, guix-set-buffer)
(guix-history-call, guix-make-history-item)
(guix-get-params-for-receiving, guix-revert-buffer)
(guix-redisplay-buffer): New functions.
(guix-define-buffer-type): Do not generate specialized functions.
* emacs/guix-info.el (guix-package-info-insert-full-names): Use
'guix-get-show-entries'.
(guix-generation-info-insert-number): Likewise.
* emacs/guix-list.el (guix-list-describe): New function.
(guix-list-define-entry-type): Do not generate specialized one.
(guix-generation-list-show-packages): Use 'guix-get-show-entries'.
* emacs/guix.el (guix-show-generations-function): Remove.
(guix-get-show-packages): Use new functions.
(guix-get-show-generations): Likewise.
---
emacs/guix-base.el | 292 ++++++++++++++++++++++++++++-------------------------
emacs/guix-info.el | 9 +-
emacs/guix-list.el | 42 ++++----
emacs/guix.el | 38 +++----
4 files changed, 198 insertions(+), 183 deletions(-)
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index 563df49..d4ac643 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -1,4 +1,4 @@
-;;; guix-base.el --- Common definitions
+;;; guix-base.el --- Common definitions -*- lexical-binding: t -*-
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
@@ -179,6 +179,14 @@ PARAM is a name of the entry parameter.
VAL is a value of this parameter.")
(put 'guix-entries 'permanent-local t)
+(defvar-local guix-buffer-type nil
+ "Type of the current buffer.")
+(put 'guix-buffer-type 'permanent-local t)
+
+(defvar-local guix-entry-type nil
+ "Type of the current entry.")
+(put 'guix-entry-type 'permanent-local t)
+
(defvar-local guix-search-type nil
"Type of the current search.")
(put 'guix-search-type 'permanent-local t)
@@ -187,42 +195,32 @@ VAL is a value of this parameter.")
"Values of the current search.")
(put 'guix-search-vals 'permanent-local t)
-(defsubst guix-set-vars (entries search-type search-vals)
- (setq guix-entries entries
+(defsubst guix-set-vars (entries buffer-type entry-type
+ search-type search-vals)
+ (setq guix-entries entries
+ guix-buffer-type buffer-type
+ guix-entry-type entry-type
guix-search-type search-type
guix-search-vals search-vals))
-(defmacro guix-define-buffer-type (buf-type entry-type &rest args)
- "Define common stuff for BUF-TYPE buffers for displaying entries.
+(defun guix-get-symbol (postfix buffer-type &optional entry-type)
+ (intern (concat "guix-"
+ (when entry-type
+ (concat (symbol-name entry-type) "-"))
+ (symbol-name buffer-type) "-" postfix)))
-ENTRY-TYPE is a type of displayed entries (see
-`guix-get-entries').
+(defmacro guix-define-buffer-type (buf-type entry-type &rest args)
+ "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries.
In the text below TYPE means ENTRY-TYPE-BUF-TYPE.
-This macro defines `guix-TYPE-mode', a custom group, several user
-variables and the following functions:
-
- - `guix-TYPE-get-params-for-receiving'
- - `guix-TYPE-revert'
- - `guix-TYPE-redisplay'
- - `guix-TYPE-make-history-item'
- - `guix-TYPE-set'
- - `guix-TYPE-show'
- - `guix-TYPE-get-show'
+This macro defines `guix-TYPE-mode', a custom group and several
+user variables.
The following stuff should be defined outside this macro:
- `guix-BUF-TYPE-mode' - parent mode for the defined mode.
- - `guix-BUF-TYPE-insert-entries' - function for inserting
- entries in the current buffer; it is called with 2 arguments:
- entries of the form of `guix-entries' and ENTRY-TYPE.
-
- - `guix-BUF-TYPE-get-displayed-params' - function returning a
- list of parameters displayed in the current buffer; it is
- called with ENTRY-TYPE as argument.
-
- `guix-TYPE-mode-initialize' (optional) - function for
additional mode settings; it is called without arguments.
@@ -252,15 +250,8 @@ following keywords are available:
(mode-init-fun (intern (concat prefix "-mode-initialize")))
(buf-name-var (intern (concat prefix "-buffer-name")))
(revert-var (intern (concat prefix "-revert-no-confirm")))
- (revert-fun (intern (concat prefix "-revert")))
- (redisplay-fun (intern (concat prefix "-redisplay")))
(history-var (intern (concat prefix "-history-size")))
- (history-fun (intern (concat prefix "-make-history-item")))
(params-var (intern (concat prefix "-required-params")))
- (params-fun (intern (concat prefix "-get-params-for-receiving")))
- (set-fun (intern (concat prefix "-set")))
- (show-fun (intern (concat prefix "-show")))
- (get-show-fun (intern (concat prefix "-get-show")))
(revert-val nil)
(history-val 20)
(params-val '(id)))
@@ -309,7 +300,7 @@ following keywords are available:
(define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
,(concat "Major mode for displaying information about " entry-str ".\n\n"
"\\{" mode-map-str "}")
- (setq-local revert-buffer-function ',revert-fun)
+ (setq-local revert-buffer-function 'guix-revert-buffer)
(setq-local guix-history-size ,history-var)
(and (fboundp ',mode-init-fun) (,mode-init-fun)))
@@ -317,88 +308,140 @@ following keywords are available:
(define-key map (kbd "l") 'guix-history-back)
(define-key map (kbd "r") 'guix-history-forward)
(define-key map (kbd "g") 'revert-buffer)
- (define-key map (kbd "R") ',redisplay-fun)
- (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))
-
- (defun ,params-fun ()
- ,(concat "Return " entry-type-str " parameters that should be received.")
- (unless (equal ,params-var 'all)
- (cl-union ,params-var
- (,(intern (concat "guix-" buf-type-str "-get-displayed-params"))
- ',entry-type))))
-
- (defun ,revert-fun (_ignore-auto noconfirm)
- "Update information in the current buffer.
+ (define-key map (kbd "R") 'guix-redisplay-buffer)
+ (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)))))
+
+(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
+
+\f
+;;; Getting info about packages and generations
+
+(defun guix-get-entries (entry-type search-type search-vals
+ &optional params)
+ "Search for entries of ENTRY-TYPE.
+
+Call an appropriate scheme function and return a list of the
+form of `guix-entries'.
+
+ENTRY-TYPE should be one of the following symbols: `package' or
+`generation'.
+
+SEARCH-TYPE may be one of the following symbols:
+
+- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp',
+ `all-available', `newest-available', `installed', `obsolete',
+ `generation'.
+
+- If ENTRY-TYPE is `generation': `id', `last', `all'.
+
+PARAMS is a list of parameters for receiving. If nil, get
+information with all available parameters."
+ (guix-eval-read (guix-make-guile-expression
+ 'get-entries
+ guix-current-profile params
+ entry-type search-type search-vals)))
+
+(defun guix-get-show-entries (buffer-type entry-type search-type
+ &rest search-vals)
+ "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer.
+See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS."
+ (let ((entries (guix-get-entries entry-type search-type search-vals
+ (guix-get-params-for-receiving
+ buffer-type entry-type))))
+ (guix-set-buffer entries buffer-type entry-type
+ search-type search-vals)))
+
+(defun guix-set-buffer (entries buffer-type entry-type search-type
+ search-vals &optional history-replace)
+ "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES.
+
+Display ENTRIES, set variables and make history item.
+ENTRIES should have a form of `guix-entries'.
+
+See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS.
+
+If HISTORY-REPLACE is non-nil, replace current history item,
+otherwise add the new one."
+ (when entries
+ (let ((buf (if (eq major-mode (guix-get-symbol
+ "mode" buffer-type entry-type))
+ (current-buffer)
+ (get-buffer-create
+ (symbol-value
+ (guix-get-symbol "buffer-name"
+ buffer-type entry-type))))))
+ (with-current-buffer buf
+ (guix-show-entries entries buffer-type entry-type)
+ (guix-set-vars entries buffer-type entry-type
+ search-type search-vals)
+ (funcall (if history-replace
+ #'guix-history-replace
+ #'guix-history-add)
+ (guix-make-history-item)))
+ (pop-to-buffer buf
+ '((display-buffer-reuse-window
+ display-buffer-same-window)))))
+ (guix-result-message entries entry-type search-type search-vals))
+
+(defun guix-show-entries (entries buffer-type entry-type)
+ "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (funcall (symbol-function (guix-get-symbol
+ "mode" buffer-type entry-type)))
+ (funcall (guix-get-symbol "insert-entries" buffer-type)
+ entries entry-type)
+ (goto-char (point-min))))
+
+(defun guix-history-call (entries buffer-type entry-type
+ search-type search-vals)
+ "Function called for moving by history."
+ (guix-show-entries entries buffer-type entry-type)
+ (guix-set-vars entries buffer-type entry-type
+ search-type search-vals)
+ (guix-result-message entries entry-type search-type search-vals))
+
+(defun guix-make-history-item ()
+ "Make and return a history item for the current buffer."
+ (list #'guix-history-call
+ guix-entries guix-buffer-type guix-entry-type
+ guix-search-type guix-search-vals))
+
+(defun guix-get-params-for-receiving (buffer-type entry-type)
+ "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE."
+ (let* ((required-var (guix-get-symbol "required-params"
+ buffer-type entry-type))
+ (required (symbol-value required-var)))
+ (unless (equal required 'all)
+ (cl-union required
+ (funcall (guix-get-symbol "get-displayed-params"
+ buffer-type)
+ entry-type)))))
+
+(defun guix-revert-buffer (_ignore-auto noconfirm)
+ "Update information in the current buffer.
The function is suitable for `revert-buffer-function'.
See `revert-buffer' for the meaning of NOCONFIRM."
- (when (or ,revert-var
- noconfirm
- (y-or-n-p "Update current information? "))
- (let ((entries (guix-get-entries ',entry-type guix-search-type
- guix-search-vals (,params-fun))))
- (,set-fun entries guix-search-type guix-search-vals t))))
-
- (defun ,redisplay-fun ()
- "Redisplay current information.
+ (when (or noconfirm
+ (symbol-value
+ (guix-get-symbol "revert-no-confirm"
+ guix-buffer-type guix-entry-type))
+ (y-or-n-p "Update current information? "))
+ (let ((entries (guix-get-entries
+ guix-entry-type guix-search-type guix-search-vals
+ (guix-get-params-for-receiving guix-buffer-type
+ guix-entry-type))))
+ (guix-set-buffer entries guix-buffer-type guix-entry-type
+ guix-search-type guix-search-vals t))))
+
+(defun guix-redisplay-buffer ()
+ "Redisplay current information.
This function will not update the information, use
\"\\[revert-buffer]\" if you want the full update."
- (interactive)
- (,show-fun guix-entries)
- (guix-result-message guix-entries ',entry-type
- guix-search-type guix-search-vals))
-
- (defun ,history-fun ()
- "Make and return a history item for the current buffer."
- (list (lambda (entries search-type search-vals)
- (,show-fun entries)
- (guix-set-vars entries search-type search-vals)
- (guix-result-message entries ',entry-type
- search-type search-vals))
- guix-entries guix-search-type guix-search-vals))
-
- (defun ,set-fun (entries search-type search-vals &optional history-replace)
- ,(concat "Set up the " buf-str " for displaying " entry-str ".\n\n"
- "Display ENTRIES, set variables and make history item.\n\n"
- "ENTRIES should have a form of `guix-entries'.\n\n"
- "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
- "SEARCH-VALS.\n\n"
- "If HISTORY-REPLACE is non-nil, replace current history item,\n"
- "otherwise add the new one.")
- (when entries
- (let ((buf (if (eq major-mode ',mode)
- (current-buffer)
- (get-buffer-create ,buf-name-var))))
- (with-current-buffer buf
- (,show-fun entries)
- (guix-set-vars entries search-type search-vals)
- (funcall (if history-replace
- #'guix-history-replace
- #'guix-history-add)
- (,history-fun)))
- (pop-to-buffer buf
- '((display-buffer-reuse-window
- display-buffer-same-window)))))
- (guix-result-message entries ',entry-type
- search-type search-vals))
-
- (defun ,show-fun (entries)
- ,(concat "Display " entry-type-str " ENTRIES in the current " buf-str ".")
- (let ((inhibit-read-only t))
- (erase-buffer)
- (,mode)
- (,(intern (concat "guix-" buf-type-str "-insert-entries"))
- entries ',entry-type)
- (goto-char (point-min))))
-
- (defun ,get-show-fun (search-type &rest search-vals)
- ,(concat "Search for " entry-str " and show results in the " buf-str ".\n"
- "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
- "SEARCH-VALS.")
- (let ((entries (guix-get-entries ',entry-type search-type
- search-vals (,params-fun))))
- (,set-fun entries search-type search-vals))))))
-
-(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
+ (interactive)
+ (guix-show-entries guix-entries guix-buffer-type guix-entry-type)
+ (guix-result-message guix-entries guix-entry-type
+ guix-search-type guix-search-vals))
\f
;;; Messages
@@ -467,33 +510,6 @@ This function will not update the information, use
(apply #'message format args)))
\f
-;;; Getting info about packages and generations
-
-(defun guix-get-entries (entry-type search-type search-vals &optional params)
- "Search for entries of ENTRY-TYPE.
-
-Call an appropriate scheme function and return a list of the
-form of `guix-entries'.
-
-ENTRY-TYPE should be one of the following symbols: `package' or
-`generation'.
-
-SEARCH-TYPE may be one of the following symbols:
-
-- If ENTRY-TYPE is `package': `id', `name', `regexp',
- `all-available', `newest-available', `installed', `obsolete',
- `generation'.
-
-- If ENTRY-TYPE is `generation': `id', `last', `all'.
-
-PARAMS is a list of parameters for receiving. If nil, get
-information with all available parameters."
- (guix-eval-read (guix-make-guile-expression
- 'get-entries
- guix-current-profile params
- entry-type search-type search-vals)))
-
-\f
;;; Actions on packages and generations
(defcustom guix-operation-confirm t
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index 687a15e..e7fc7f0 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -427,7 +427,8 @@ Propertize package button with FACE."
(guix-insert-button
name face
(lambda (btn)
- (guix-package-info-get-show 'name (button-label btn)))
+ (guix-get-show-entries 'info 'package 'name
+ (button-label btn)))
"Describe this package"))
\f
@@ -532,8 +533,6 @@ ENTRY is an alist with package info."
"Face used for a number of a generation."
:group 'guix-generation-info)
-(declare-function guix-package-list-get-show "guix-list" t t)
-
(defun guix-generation-info-insert-number (number &optional _)
"Insert generation NUMBER and action buttons."
(guix-info-insert-val-default number 'guix-generation-info-number)
@@ -541,8 +540,8 @@ ENTRY is an alist with package info."
(guix-info-insert-action-button
"Packages"
(lambda (btn)
- (guix-package-list-get-show 'generation
- (button-get btn 'number)))
+ (guix-get-show-entries 'list 'package 'generation
+ (button-get btn 'number)))
"Show installed packages for this generation"
'number number)
(guix-info-insert-indent)
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index 8d9b231..3732d9b 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -343,6 +343,7 @@ Same as `tabulated-list-sort', but also restore marks after sorting."
(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)
@@ -371,16 +372,12 @@ following keywords are available:
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)
@@ -409,22 +406,6 @@ This macro defines the following functions:
(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
@@ -439,6 +420,21 @@ This macro defines the following functions:
(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
+(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))))
+ (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 guix-entry-type 'id ids))))
+
\f
;;; Displaying packages
@@ -477,7 +473,6 @@ likely)."
: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 "d") 'guix-package-list-mark-delete)
@@ -617,13 +612,14 @@ The specification is suitable for `guix-process-package-actions'."
(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 'package 'generation
+ (guix-list-current-id)))
(provide 'guix-list)
diff --git a/emacs/guix.el b/emacs/guix.el
index 7336f67..621dd3b 100644
--- a/emacs/guix.el
+++ b/emacs/guix.el
@@ -28,6 +28,7 @@
;;; Code:
+(require 'guix-base)
(require 'guix-list)
(require 'guix-info)
@@ -42,12 +43,6 @@ If nil, show a single package in the info buffer."
:type 'boolean
:group 'guix)
-(defcustom guix-show-generations-function 'guix-generation-list-get-show
- "Default function used to display generations."
- :type '(choice (function-item guix-generation-list-get-show)
- (function-item guix-generation-info-get-show))
- :group 'guix)
-
(defvar guix-search-params '(name synopsis description)
"Default list of package parameters for searching by regexp.")
@@ -62,22 +57,31 @@ SEARCH-VALS.
Results are displayed in the list buffer, unless a single package
is found and `guix-list-single-package' is nil."
- (let* ((list-params (guix-package-list-get-params-for-receiving))
- (packages (guix-get-entries 'package search-type
- search-vals list-params)))
+ (let* ((list-params (guix-get-params-for-receiving
+ 'list 'package))
+ (packages (guix-get-entries 'package
+ search-type search-vals
+ list-params)))
(if (or guix-list-single-package
(cdr packages))
- (guix-package-list-set packages search-type search-vals)
- (let ((info-params (guix-package-info-get-params-for-receiving)))
- (unless (equal list-params info-params)
- ;; If we don't have required info, we should receive it again
- (setq packages (guix-get-entries 'package search-type
- search-vals info-params))))
- (guix-package-info-set packages search-type search-vals))))
+ (guix-set-buffer packages 'list 'package
+ search-type search-vals)
+ (let* ((info-params (guix-get-params-for-receiving
+ 'info 'package))
+ (packages (if (equal list-params info-params)
+ packages
+ ;; If we don't have required info, we should
+ ;; receive it again
+ (guix-get-entries 'package
+ search-type search-vals
+ info-params))))
+ (guix-set-buffer packages 'info 'package
+ search-type search-vals)))))
(defun guix-get-show-generations (search-type &rest search-vals)
"Search for generations and show results."
- (apply guix-show-generations-function search-type search-vals))
+ (apply #'guix-get-show-entries
+ 'list 'generation search-type search-vals))
;;;###autoload
(defun guix-search-by-name (name)
--
2.1.0
[-- Attachment #3: 0002-emacs-Rewrite-scheme-side-in-a-functional-manner.patch --]
[-- Type: text/x-diff, Size: 41019 bytes --]
From d42829fe03271e633e43cc35cf277705203e6080 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Thu, 18 Sep 2014 16:24:02 +0400
Subject: [PATCH 2/3] emacs: Rewrite scheme side in a functional manner.
* emacs/guix-main.scm: Rewrite in a functional way. Add support for output
entries.
(%current-manifest, %current-manifest-entries-table,
set-current-manifest-maybe!): Replace with...
(mentries->hash-table, manifest->hash-table): ... this.
(manifest-entries-by-name+version): Replace with...
(mentries-by-name): ... this.
(fold-manifest-entries): Rename to...
(fold-manifest-by-name): ... this.
(package-installed-param-alist): Rename to...
(%mentry-param-alist): ... this.
(package-param-alist): Rename to...
(%package-param-alist): this.
(manifest-entry->installed-entry): Rename to...
(mentry->alist): ... this.
(matching-generation-entries): Replace with...
(matching-generations): ... this.
(last-generation-entries): Replace with...
(last-generations): ... this.
(manifest-entries->installed-entries, installed-entries-by-name+version,
installed-entries-by-package, matching-package-entries, fold-object,
package-entries-by-name+version, package-entries-by-spec,
package-entries-by-regexp, package-entries-by-ids,
newest-available-package-entries, all-available-package-entries,
manifest-package-entries, installed-package-entries,
generation-package-entries, obsolete-package-entries,
all-generation-entries, generation-entries-by-ids,
%package-entries-functions, %generation-entries-functions): Remove.
(manifest=?, mentry->name+version+output, mentry-by-output, list-maybe,
matching-packages, filter-packages-by-output, packages-by-name,
mentry->packages, all-available-packages, newest-available-packages,
spec->package-pattern, spec->output-pattern, id->package-pattern,
id->output-pattern, specs->package-patterns, specs->output-patterns,
ids->package-patterns, ids->output-patterns, obsolete-package-patterns,
obsolete-output-patterns, manifest-package-patterns,
manifest-output-patterns, make-installed-alists, make-package-entry,
make-output-entry, make-obsolete-output-entry, package-pattern-transformer,
output-pattern-transformer, entry-type-error, search-type-error,
pattern-transformer, patterns-maker, get-package/output-entries,
find-generations, get-generation-entries): New procedures.
(%pattern-transformers, %patterns-makers): New variables.
(get-entries): Use 'get-package/output-entries', 'get-generation-entries'.
* emacs/guix-base.el (guix-continue-package-operation-p): Adjust accordingly.
* emacs/guix-info.el (guix-package-info-insert-action-button): Likewise.
---
emacs/guix-base.el | 6 +-
emacs/guix-info.el | 3 +-
emacs/guix-main.scm | 772 ++++++++++++++++++++++++++++++++--------------------
3 files changed, 480 insertions(+), 301 deletions(-)
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index d4ac643..1959814 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -563,9 +563,9 @@ See `guix-process-package-actions' for details."
(or (null guix-operation-confirm)
(let* ((entries (guix-get-entries
'package 'id
- (list (append (mapcar #'car install)
- (mapcar #'car upgrade)
- (mapcar #'car remove)))
+ (append (mapcar #'car install)
+ (mapcar #'car upgrade)
+ (mapcar #'car remove))
'(id name version location)))
(install-strings (guix-get-package-strings install entries))
(upgrade-strings (guix-get-package-strings upgrade entries))
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index e7fc7f0..05281e7 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -512,7 +512,8 @@ ENTRY is an alist with package info."
(button-get btn 'output)))))
(concat type-str " '" full-name "'")
'action-type type
- 'id (guix-get-key-val entry 'id)
+ 'id (or (guix-get-key-val entry 'package-id)
+ (guix-get-key-val entry 'id))
'output output)))
(defun guix-package-info-insert-output-path (path &optional _)
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 1383d08..9295894 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -24,11 +24,12 @@
;; this code. So to distinguish, just "package" in the name of a
;; function means a guile object ("package" record) while
;; "package entry" means alist of package parameters and values (see
-;; ‘package-param-alist’).
+;; ‘%package-param-alist’).
;;
;; "Entry" is probably not the best name for such alists, because there
;; already exists "manifest-entry" which has nothing to do with the
-;; "entry" described above. Do not be confused :)
+;; "entry" described above. Do not be confused. "Manifest entries" are
+;; shortened to "mentries" in this file.
;; ‘get-entries’ function is the “entry point” for the elisp side to get
;; information about packages and generations.
@@ -46,7 +47,7 @@
;;
;; ‘installed’ parameter of a package entry contains information about
;; installed outputs. It is a list of "installed entries" (see
-;; ‘package-installed-param-alist’).
+;; ‘%mentry-param-alist’).
;; To speed-up the process of getting information, the following
;; auxiliary variables are used:
@@ -55,10 +56,6 @@
;;
;; - `%package-table' - Hash table of
;; "name+version key"/"list of packages" pairs.
-;;
-;; - `%current-manifest-entries-table' - Hash table of
-;; "name+version key"/"list of manifest entries" pairs. This variable
-;; is set by `set-current-manifest-maybe!' when it is needed.
;;; Code:
@@ -97,9 +94,6 @@
(define name+version->key cons)
(define key->name+version car+cdr)
-(define %current-manifest #f)
-(define %current-manifest-entries-table #f)
-
(define %packages
(fold-packages (lambda (pkg res)
(vhash-consq (object-address pkg) pkg res))
@@ -119,90 +113,74 @@
%packages)
table))
-;; FIXME get rid of this function!
-(define (set-current-manifest-maybe! profile)
- (define (manifest-entries->hash-table entries)
- (let ((entries-table (make-hash-table (length entries))))
- (for-each (lambda (entry)
- (let* ((key (name+version->key
- (manifest-entry-name entry)
- (manifest-entry-version entry)))
- (ref (hash-ref entries-table key)))
- (hash-set! entries-table key
- (if ref (cons entry ref) (list entry)))))
- entries)
- entries-table))
-
- (when profile
- (let ((manifest (profile-manifest profile)))
- (unless (and (manifest? %current-manifest)
- (equal? manifest %current-manifest))
- (set! %current-manifest manifest)
- (set! %current-manifest-entries-table
- (manifest-entries->hash-table
- (manifest-entries manifest)))))))
-
-(define (manifest-entries-by-name+version name version)
- (or (hash-ref %current-manifest-entries-table
- (name+version->key name version))
- '()))
-
-(define (packages-by-name+version name version)
- (or (hash-ref %package-table
- (name+version->key name version))
- '()))
-
-(define (packages-by-full-name full-name)
- (call-with-values
- (lambda () (full-name->name+version full-name))
- packages-by-name+version))
-
-(define (package-by-address address)
- (and=> (vhash-assq address %packages)
- cdr))
-
-(define (packages-by-id id)
- (if (integer? id)
- (let ((pkg (package-by-address id)))
- (if pkg (list pkg) '()))
- (packages-by-full-name id)))
-
-(define (package-by-id id)
- (first-or-false (packages-by-id id)))
-
-(define (newest-package-by-id id)
- (and=> (id->name+version id)
- (lambda (name)
- (first-or-false (find-best-packages-by-name name #f)))))
-
-(define (id->name+version id)
- (if (integer? id)
- (and=> (package-by-address id)
- (lambda (pkg)
- (values (package-name pkg)
- (package-version pkg))))
- (full-name->name+version id)))
+(define (mentry->name+version+output mentry)
+ (values
+ (manifest-entry-name mentry)
+ (manifest-entry-version mentry)
+ (manifest-entry-output mentry)))
+
+(define (mentries->hash-table mentries)
+ "Return hash table of name keys and lists of matching MENTRIES."
+ (let ((table (make-hash-table (length mentries))))
+ (for-each (lambda (mentry)
+ (let* ((key (manifest-entry-name mentry))
+ (ref (hash-ref table key)))
+ (hash-set! table key
+ (if ref (cons mentry ref) (list mentry)))))
+ mentries)
+ table))
-(define (fold-manifest-entries proc init)
- "Fold over `%current-manifest-entries-table'.
-Call (PROC NAME VERSION ENTRIES RESULT) for each element of the hash
-table, using INIT as the initial value of RESULT."
- (hash-fold (lambda (key entries res)
- (let-values (((name version) (key->name+version key)))
- (proc name version entries res)))
+(define (manifest=? m1 m2)
+ (or (eq? m1 m2)
+ (equal? m1 m2)))
+
+(define manifest->hash-table
+ (let ((current-manifest #f)
+ (current-table #f))
+ (lambda (manifest)
+ "Return hash table of name keys and lists of matching MANIFEST entries."
+ (unless (manifest=? manifest current-manifest)
+ (set! current-manifest manifest)
+ (set! current-table (mentries->hash-table
+ (manifest-entries manifest))))
+ current-table)))
+
+(define* (mentries-by-name manifest name #:optional version output)
+ "Return list of MANIFEST entries matching NAME, VERSION and OUTPUT."
+ (let ((mentries (or (hash-ref (manifest->hash-table manifest) name)
+ '())))
+ (if (or version output)
+ (filter (lambda (mentry)
+ (and (or (not version)
+ (equal? version (manifest-entry-version mentry)))
+ (or (not output)
+ (equal? output (manifest-entry-output mentry)))))
+ mentries)
+ mentries)))
+
+(define (mentry-by-output mentries output)
+ (find (lambda (mentry)
+ (string= output (manifest-entry-output mentry)))
+ mentries))
+
+(define (fold-manifest-by-name manifest proc init)
+ "Fold over MANIFEST entries.
+Call (PROC NAME VERSION MENTRIES RESULT), using INIT as the initial value
+of RESULT. MENTRIES is a list of manifest entries with NAME/VERSION."
+ (hash-fold (lambda (name mentries res)
+ (proc name (manifest-entry-version (car mentries))
+ mentries res))
init
- %current-manifest-entries-table))
+ (manifest->hash-table manifest)))
-(define (fold-object proc init obj)
- (fold proc init
- (if (list? obj) obj (list obj))))
+(define (list-maybe obj)
+ (if (list? obj) obj (list obj)))
(define* (object-transformer param-alist #:optional (params '()))
- "Return function for transforming an object into alist of parameters/values.
+ "Return function for transforming objects into alist of parameters/values.
-PARAM-ALIST is alist of available object parameters (symbols) and functions
-returning values of these parameters. Each function is called with object as
-a single argument.
+PARAM-ALIST is alist of available parameters (symbols) and functions returning
+values of these parameters. Each function is applied to objects.
PARAMS is list of parameters from PARAM-ALIST that should be returned by a
resulting function. If PARAMS is not specified or is an empty list, use all
@@ -224,31 +202,19 @@ Example:
(cons param fun)))
(_ #f))
param-alist))))
- (lambda (object)
+ (lambda objects
(map (match-lambda
((param . fun)
- (cons param (fun object))))
+ (cons param (apply fun objects))))
alist))))
-(define package-installed-param-alist
- (list
- (cons 'output manifest-entry-output)
- (cons 'path manifest-entry-item)
- (cons 'dependencies manifest-entry-dependencies)))
-
-(define manifest-entry->installed-entry
- (object-transformer package-installed-param-alist))
-
-(define (manifest-entries->installed-entries entries)
- (map manifest-entry->installed-entry entries))
-
-(define (installed-entries-by-name+version name version)
- (manifest-entries->installed-entries
- (manifest-entries-by-name+version name version)))
+(define %mentry-param-alist
+ `((output . ,manifest-entry-output)
+ (path . ,manifest-entry-item)
+ (dependencies . ,manifest-entry-dependencies)))
-(define (installed-entries-by-package package)
- (installed-entries-by-name+version (package-name package)
- (package-version package)))
+(define mentry->alist
+ (object-transformer %mentry-param-alist))
(define (package-inputs-names inputs)
"Return list of full names of the packages from package INPUTS."
@@ -260,89 +226,112 @@ Example:
(define (package-license-names package)
"Return list of license names of the PACKAGE."
- (fold-object (lambda (license res)
- (if (license? license)
- (cons (license-name license) res)
- res))
- '()
- (package-license package)))
+ (filter-map (lambda (license)
+ (and (license? license)
+ (license-name license)))
+ (list-maybe (package-license package))))
(define (package-unique? package)
"Return #t if PACKAGE is a single package with such name/version."
- (null? (cdr (packages-by-name+version (package-name package)
- (package-version package)))))
-
-(define package-param-alist
- (list
- (cons 'id object-address)
- (cons 'name package-name)
- (cons 'version package-version)
- (cons 'license package-license-names)
- (cons 'synopsis package-synopsis)
- (cons 'description package-description)
- (cons 'home-url package-home-page)
- (cons 'outputs package-outputs)
- (cons 'non-unique (negate package-unique?))
- (cons 'inputs (lambda (pkg) (package-inputs-names
- (package-inputs pkg))))
- (cons 'native-inputs (lambda (pkg) (package-inputs-names
- (package-native-inputs pkg))))
- (cons 'propagated-inputs (lambda (pkg) (package-inputs-names
- (package-propagated-inputs pkg))))
- (cons 'location (lambda (pkg) (location->string
- (package-location pkg))))
- (cons 'installed installed-entries-by-package)))
+ (null? (cdr (packages-by-name (package-name package)
+ (package-version package)))))
+
+(define %package-param-alist
+ `((id . ,object-address)
+ (package-id . ,object-address)
+ (name . ,package-name)
+ (version . ,package-version)
+ (license . ,package-license-names)
+ (synopsis . ,package-synopsis)
+ (description . ,package-description)
+ (home-url . ,package-home-page)
+ (outputs . ,package-outputs)
+ (non-unique . ,(negate package-unique?))
+ (inputs . ,(lambda (pkg)
+ (package-inputs-names
+ (package-inputs pkg))))
+ (native-inputs . ,(lambda (pkg)
+ (package-inputs-names
+ (package-native-inputs pkg))))
+ (propagated-inputs . ,(lambda (pkg)
+ (package-inputs-names
+ (package-propagated-inputs pkg))))
+ (location . ,(lambda (pkg)
+ (location->string (package-location pkg))))))
(define (package-param package param)
"Return the value of a PACKAGE PARAM."
- (define (accessor param)
- (and=> (assq param package-param-alist)
- cdr))
- (and=> (accessor param)
+ (and=> (assq-ref %package-param-alist param)
(cut <> package)))
-(define (matching-package-entries ->entry predicate)
- "Return list of package entries for the matching packages.
-PREDICATE is called on each package."
+\f
+;;; Finding packages
+
+(define (package-by-address address)
+ (and=> (vhash-assq address %packages)
+ cdr))
+
+(define (packages-by-name+version name version)
+ (or (hash-ref %package-table
+ (name+version->key name version))
+ '()))
+
+(define (packages-by-full-name full-name)
+ (call-with-values
+ (lambda () (full-name->name+version full-name))
+ packages-by-name+version))
+
+(define (packages-by-id id)
+ (if (integer? id)
+ (let ((pkg (package-by-address id)))
+ (if pkg (list pkg) '()))
+ (packages-by-full-name id)))
+
+(define (id->name+version id)
+ (if (integer? id)
+ (and=> (package-by-address id)
+ (lambda (pkg)
+ (values (package-name pkg)
+ (package-version pkg))))
+ (full-name->name+version id)))
+
+(define (package-by-id id)
+ (first-or-false (packages-by-id id)))
+
+(define (newest-package-by-id id)
+ (and=> (id->name+version id)
+ (lambda (name)
+ (first-or-false (find-best-packages-by-name name #f)))))
+
+(define (matching-packages predicate)
(fold-packages (lambda (pkg res)
(if (predicate pkg)
- (cons (->entry pkg) res)
+ (cons pkg res)
res))
'()))
-(define (make-obsolete-package-entry name version entries)
- "Return package entry for an obsolete package with NAME and VERSION.
-ENTRIES is a list of manifest entries used to get installed info."
- `((id . ,(name+version->full-name name version))
- (name . ,name)
- (version . ,version)
- (outputs . ,(map manifest-entry-output entries))
- (obsolete . #t)
- (installed . ,(manifest-entries->installed-entries entries))))
-
-(define (package-entries-by-name+version ->entry name version)
- "Return list of package entries for packages with NAME and VERSION."
- (let ((packages (packages-by-name+version name version)))
- (if (null? packages)
- (let ((entries (manifest-entries-by-name+version name version)))
- (if (null? entries)
- '()
- (list (make-obsolete-package-entry name version entries))))
- (map ->entry packages))))
+(define (filter-packages-by-output packages output)
+ (filter (lambda (package)
+ (member output (package-outputs package)))
+ packages))
+
+(define* (packages-by-name name #:optional version output)
+ "Return list of packages matching NAME, VERSION and OUTPUT."
+ (let ((packages (if version
+ (packages-by-name+version name version)
+ (matching-packages
+ (lambda (pkg) (string=? name (package-name pkg)))))))
+ (if output
+ (filter-packages-by-output packages output)
+ packages)))
-(define (package-entries-by-spec profile ->entry spec)
- "Return list of package entries for packages with name specification SPEC."
- (set-current-manifest-maybe! profile)
- (let-values (((name version)
- (full-name->name+version spec)))
- (if version
- (package-entries-by-name+version ->entry name version)
- (matching-package-entries
- ->entry
- (lambda (pkg) (string=? name (package-name pkg)))))))
+(define (mentry->packages mentry)
+ (call-with-values
+ (lambda () (mentry->name+version+output mentry))
+ packages-by-name))
-(define (package-entries-by-regexp profile ->entry regexp match-params)
- "Return list of package entries for packages matching REGEXP string.
+(define (packages-by-regexp regexp match-params)
+ "Return list of packages matching REGEXP string.
MATCH-PARAMS is a list of parameters that REGEXP can match."
(define (package-match? package regexp)
(any (lambda (param)
@@ -350,81 +339,297 @@ MATCH-PARAMS is a list of parameters that REGEXP can match."
(and (string? val) (regexp-exec regexp val))))
match-params))
- (set-current-manifest-maybe! profile)
(let ((re (make-regexp regexp regexp/icase)))
- (matching-package-entries ->entry (cut package-match? <> re))))
-
-(define (package-entries-by-ids profile ->entry ids)
- "Return list of package entries for packages matching KEYS.
-IDS may be an object-address, a full-name or a list of such elements."
- (set-current-manifest-maybe! profile)
- (fold-object
- (lambda (id res)
- (if (integer? id)
- (let ((pkg (package-by-address id)))
- (if pkg
- (cons (->entry pkg) res)
- res))
- (let ((entries (package-entries-by-spec #f ->entry id)))
- (if (null? entries)
- res
- (append res entries)))))
- '()
- ids))
-
-(define (newest-available-package-entries profile ->entry)
- "Return list of package entries for the newest available packages."
- (set-current-manifest-maybe! profile)
+ (matching-packages (cut package-match? <> re))))
+
+(define (all-available-packages)
+ "Return list of all available packages."
+ (matching-packages (const #t)))
+
+(define (newest-available-packages)
+ "Return list of the newest available packages."
(vhash-fold (lambda (name elem res)
(match elem
- ((version newest pkgs ...)
- (cons (->entry newest) res))))
+ ((_ newest pkgs ...)
+ (cons newest res))))
'()
(find-newest-available-packages)))
-(define (all-available-package-entries profile ->entry)
- "Return list of package entries for all available packages."
- (set-current-manifest-maybe! profile)
- (matching-package-entries ->entry (const #t)))
+\f
+;;; Making package/output patterns
-(define (manifest-package-entries ->entry)
- "Return list of package entries for the current manifest."
- (fold-manifest-entries
- (lambda (name version entries res)
- ;; We don't care about duplicates for the list of
- ;; installed packages, so just take any package (car)
- ;; matching name+version
- (cons (car (package-entries-by-name+version ->entry name version))
- res))
- '()))
+(define (spec->package-pattern spec)
+ (call-with-values
+ (lambda () (full-name->name+version spec))
+ list))
+
+(define (spec->output-pattern spec)
+ (call-with-values
+ (lambda () (package-specification->name+version+output spec #f))
+ list))
+
+(define (id->package-pattern id)
+ (if (integer? id)
+ (package-by-address id)
+ (spec->package-pattern id)))
+
+(define (id->output-pattern id)
+ ;; id should be "<package-address>:<output>" or "<name>-<version>:<output>"
+ (let-values (((name version output)
+ (package-specification->name+version+output id)))
+ (if version
+ (list name version output)
+ (list (package-by-address (string->number name))
+ output))))
+
+(define (specs->package-patterns . specs)
+ (map spec->package-pattern specs))
+
+(define (specs->output-patterns . specs)
+ (map spec->output-pattern specs))
+
+(define (ids->package-patterns . ids)
+ (map id->package-pattern ids))
-(define (installed-package-entries profile ->entry)
- "Return list of package entries for all installed packages."
- (set-current-manifest-maybe! profile)
- (manifest-package-entries ->entry))
-
-(define (generation-package-entries profile ->entry generation)
- "Return list of package entries for packages from GENERATION."
- (set-current-manifest-maybe!
- (generation-file-name profile generation))
- (manifest-package-entries ->entry))
-
-(define (obsolete-package-entries profile _)
- "Return list of package entries for obsolete packages."
- (set-current-manifest-maybe! profile)
- (fold-manifest-entries
+(define (ids->output-patterns . ids)
+ (map id->output-pattern ids))
+
+(define (obsolete-package-patterns manifest)
+ "Return list of package patterns for obsolete packages."
+ (fold-manifest-by-name
+ manifest
(lambda (name version entries res)
- (let ((packages (packages-by-name+version name version)))
+ (let ((packages (packages-by-name name version)))
(if (null? packages)
- (cons (make-obsolete-package-entry name version entries) res)
+ (cons (list name version entries '()) res)
res)))
'()))
+(define (obsolete-output-patterns manifest)
+ "Return list of output patterns for obsolete packages."
+ (fold (lambda (mentry res)
+ (let ((packages (mentry->packages mentry)))
+ (if (null? packages)
+ (cons (list mentry '()) res)
+ res)))
+ '()
+ (manifest-entries manifest)))
+
+(define (manifest-package-patterns manifest)
+ "Return list of package patterns for all MANIFEST entries."
+ (fold-manifest-by-name manifest
+ (lambda (name version mentries res)
+ (cons (list name version mentries) res))
+ '()))
+
+(define manifest-output-patterns manifest-entries)
+
+\f
+;;; Transforming package/output patterns into entries
+
+(define (make-installed-alists mentries)
+ (map mentry->alist mentries))
+
+(define (make-package-entry palist malists)
+ (cons (cons 'installed malists)
+ palist))
+
+(define (make-obsolete-package-entry name version mentries)
+ `((id . ,(name+version->full-name name version))
+ (name . ,name)
+ (version . ,version)
+ (outputs . ,(map manifest-entry-output mentries))
+ (obsolete . #t)
+ (installed . ,(make-installed-alists mentries))))
+
+(define* (make-output-entry palist package-address output
+ #:optional (malist '()) #:key installed?)
+ (let ((base `((id . ,(string-append
+ (number->string package-address)
+ ":" output))
+ (output . ,output)
+ (installed . ,installed?))))
+ (append base malist palist)))
+
+(define* (make-obsolete-output-entry name version output
+ #:optional (malist '()))
+ (let ((base `((id . ,(make-package-specification
+ name version output))
+ (package-id . ,(name+version->full-name name version))
+ (name . ,name)
+ (version . ,version)
+ (output . ,output)
+ (obsolete . #t)
+ (installed . #t))))
+ (append malist base)))
+
+(define (package-pattern-transformer manifest params)
+ "Return 'package-pattern->package-entries' function."
+ (define package->alist
+ (object-transformer %package-param-alist params))
+
+ (define (->entries pattern)
+ (match pattern
+ ((? package? package)
+ (list (make-package-entry
+ (package->alist package)
+ (make-installed-alists
+ (mentries-by-name manifest
+ (package-name package)
+ (package-version package))))))
+ ((name version)
+ (->entries (list name version
+ (mentries-by-name manifest name version))))
+ ((name version mentries)
+ (->entries (list name version mentries
+ (packages-by-name name version))))
+ ((name version mentries packages)
+ (if (null? packages)
+ (if (null? mentries)
+ '()
+ (list (make-obsolete-package-entry
+ name version mentries)))
+ (let ((malists (make-installed-alists mentries)))
+ (map (lambda (package)
+ (make-package-entry (package->alist package)
+ malists))
+ packages))))))
+
+ ->entries)
+
+(define (output-pattern-transformer manifest params)
+ "Return 'output-pattern->output-entries' function."
+ (define package->alist
+ (object-transformer (alist-delete 'id %package-param-alist)
+ params))
+
+ (define mentry->alist
+ (object-transformer (alist-delete 'output %mentry-param-alist)
+ params))
+
+ (define* (entries-by-package package #:optional output
+ (mentries (mentries-by-name
+ manifest
+ (package-name package)
+ (package-version package))))
+ ;; Assuming that PACKAGE has this OUTPUT.
+ (let ((palist (package->alist package))
+ (address (object-address package))
+ (outputs (if output
+ (list output)
+ (package-outputs package))))
+ (map (lambda (output)
+ (let* ((mentry (mentry-by-output mentries output))
+ (malist (if mentry (mentry->alist mentry) '())))
+ (make-output-entry palist address output malist
+ #:installed? (->bool mentry))))
+ outputs)))
+
+ (define* (entries-by-mentry mentry #:optional
+ (packages (mentry->packages mentry)))
+ (let-values (((name version output)
+ (mentry->name+version+output mentry)))
+ (let ((malist (mentry->alist mentry)))
+ (if (null? packages)
+ (list (make-obsolete-output-entry
+ name version output malist))
+ (map (lambda (package)
+ (make-output-entry
+ (package->alist package)
+ (object-address package)
+ output malist #:installed? #t))
+ packages)))))
+
+ (define (->entries pattern)
+ (match pattern
+ ((? package? package)
+ (entries-by-package package))
+ (((? package? package) output)
+ (entries-by-package package output))
+ ((? manifest-entry? mentry)
+ (entries-by-mentry mentry))
+ (((? manifest-entry? mentry) packages)
+ (entries-by-mentry mentry packages))
+ ((name version output)
+ (let ((packages (packages-by-name name version output))
+ (mentries (mentries-by-name manifest name version output)))
+ (if (null? mentries)
+ (append-map (cut entries-by-package <> output mentries)
+ packages)
+ (append-map (cut entries-by-mentry <> packages)
+ mentries))))))
+
+ ->entries)
+
+(define (entry-type-error entry-type)
+ (error (format #f "Wrong entry-type '~a'" entry-type)))
+
+(define (search-type-error entry-type search-type)
+ (error (format #f "Wrong search type '~a' for entry-type '~a'"
+ search-type entry-type)))
+
+(define %pattern-transformers
+ `((package . ,package-pattern-transformer)
+ (output . ,output-pattern-transformer)))
+
+(define (pattern-transformer entry-type)
+ (assq-ref %pattern-transformers entry-type))
+
+;; All functions from inner alists are called with (MANIFEST . SEARCH-VALS) as
+;; arguments; see `get-package/output-entries'.
+(define %patterns-makers
+ (let* ((apply-to-rest (lambda (fun)
+ (lambda (_ . rest) (apply fun rest))))
+ (apply-to-first (lambda (fun)
+ (lambda (first . _) (fun first))))
+ (manifest-package-fun (apply-to-first manifest-package-patterns))
+ (manifest-output-fun (apply-to-first manifest-output-patterns))
+ (regexp-fun (lambda (_ regexp params . __)
+ (packages-by-regexp regexp params)))
+ (all-fun (lambda _ (all-available-packages)))
+ (newest-fun (lambda _ (newest-available-packages))))
+ `((package
+ (id . ,(apply-to-rest ids->package-patterns))
+ (name . ,(apply-to-rest specs->package-patterns))
+ (installed . ,manifest-package-fun)
+ (generation . ,manifest-package-fun)
+ (obsolete . ,(apply-to-first obsolete-package-patterns))
+ (regexp . ,regexp-fun)
+ (all-available . ,all-fun)
+ (newest-available . ,newest-fun))
+ (output
+ (id . ,(apply-to-rest ids->output-patterns))
+ (name . ,(apply-to-rest specs->output-patterns))
+ (installed . ,manifest-output-fun)
+ (generation . ,manifest-output-fun)
+ (obsolete . ,(apply-to-first obsolete-output-patterns))
+ (regexp . ,regexp-fun)
+ (all-available . ,all-fun)
+ (newest-available . ,newest-fun)))))
+
+(define (patterns-maker entry-type search-type)
+ (or (and=> (assq-ref %patterns-makers entry-type)
+ (cut assq-ref <> search-type))
+ (search-type-error entry-type search-type)))
+
+(define (get-package/output-entries profile params entry-type
+ search-type search-vals)
+ "Return list of package or output entries."
+ (let* ((profile (if (eq? search-type 'generation)
+ (generation-file-name profile (car search-vals))
+ profile))
+ (manifest (profile-manifest profile))
+ (patterns (apply (patterns-maker entry-type search-type)
+ manifest search-vals))
+ (->entries ((pattern-transformer entry-type) manifest params)))
+ (append-map ->entries patterns)))
+
\f
;;; Generation entries
+;;; XXX move to (guix profiles) ?
(define (profile-generations profile)
- "Return list of generations for PROFILE."
+ "Return list of PROFILE generations."
(let ((generations (generation-numbers profile)))
(if (equal? generations '(0))
'()
@@ -440,74 +645,48 @@ IDS may be an object-address, a full-name or a list of such elements."
(cons 'time (lambda (gen)
(time-second (generation-time profile gen))))))
-(define (matching-generation-entries profile ->entry predicate)
- "Return list of generation entries for the matching generations.
-PREDICATE is called on each generation."
- (filter-map (lambda (gen)
- (and (predicate gen) (->entry gen)))
- (profile-generations profile)))
+(define (matching-generations profile predicate)
+ "Return list of PROFILE generations matching PREDICATE."
+ (filter predicate (profile-generations profile)))
-(define (last-generation-entries profile ->entry number)
- "Return list of last NUMBER generation entries.
-If NUMBER is 0 or less, return all generation entries."
+(define (last-generations profile number)
+ "Return list of last NUMBER generations.
+If NUMBER is 0 or less, return all generations."
(let ((generations (profile-generations profile))
(number (if (<= number 0) +inf.0 number)))
- (map ->entry
- (if (> (length generations) number)
- (list-head (reverse generations) number)
- generations))))
-
-(define (all-generation-entries profile ->entry)
- "Return list of all generation entries."
- (last-generation-entries profile ->entry +inf.0))
+ (if (> (length generations) number)
+ (list-head (reverse generations) number)
+ generations)))
-(define (generation-entries-by-ids profile ->entry ids)
- "Return list of generation entries for generations matching IDS.
-IDS is a list of generation numbers."
- (matching-generation-entries profile ->entry (cut memq <> ids)))
+(define (find-generations profile search-type search-vals)
+ (case search-type
+ ((id)
+ (matching-generations profile (cut memq <> (car search-vals))))
+ ((last)
+ (last-generations profile (car search-vals)))
+ ((all)
+ (last-generations profile +inf.0))
+ (else (search-type-error "generation" search-type))))
+
+(define (get-generation-entries profile params search-type search-vals)
+ "Return list of generation entries."
+ (let ((generations (find-generations profile search-type search-vals))
+ (->entry (object-transformer (generation-param-alist profile)
+ params)))
+ (map ->entry generations)))
\f
-;;; Getting package/generation entries
-
-(define %package-entries-functions
- (alist->vhash
- `((id . ,package-entries-by-ids)
- (name . ,package-entries-by-spec)
- (regexp . ,package-entries-by-regexp)
- (all-available . ,all-available-package-entries)
- (newest-available . ,newest-available-package-entries)
- (installed . ,installed-package-entries)
- (obsolete . ,obsolete-package-entries)
- (generation . ,generation-package-entries))
- hashq))
-
-(define %generation-entries-functions
- (alist->vhash
- `((id . ,generation-entries-by-ids)
- (last . ,last-generation-entries)
- (all . ,all-generation-entries))
- hashq))
+;;; Getting package/output/generation entries
(define (get-entries profile params entry-type search-type search-vals)
- "Return list of entries.
-ENTRY-TYPE and SEARCH-TYPE define a search function that should be
-applied to PARAMS and VALS."
- (let-values (((vhash ->entry)
- (case entry-type
- ((package)
- (values %package-entries-functions
- (object-transformer
- package-param-alist params)))
- ((generation)
- (values %generation-entries-functions
- (object-transformer
- (generation-param-alist profile) params)))
- (else (format (current-error-port)
- "Wrong entry type '~a'" entry-type)))))
- (match (vhash-assq search-type vhash)
- ((key . fun)
- (apply fun profile ->entry search-vals))
- (_ '()))))
+ (case entry-type
+ ((package output)
+ (get-package/output-entries profile params entry-type
+ search-type search-vals))
+ ((generation)
+ (get-generation-entries profile params
+ search-type search-vals))
+ (else (entry-type-error entry-type))))
\f
;;; Actions
@@ -592,12 +771,11 @@ OUTPUTS is a list of package outputs (may be an empty list)."
profile
(+ 1 (generation-number profile)))))
(and (build-derivations store derivations)
- (let* ((entries (manifest-entries new-manifest))
- (count (length entries)))
+ (let* ((mentries (manifest-entries new-manifest))
+ (count (length mentries)))
(switch-symlinks name new-profile)
(switch-symlinks profile name)
(format #t (N_ "~a package in profile~%"
"~a packages in profile~%"
count)
count)))))))))
-
--
2.1.0
[-- Attachment #4: 0003-emacs-Add-support-for-displaying-outputs.patch --]
[-- Type: text/x-diff, Size: 23281 bytes --]
From d3fbccfd8a86d6b96f77f8993e88df8fe755e15f Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Fri, 19 Sep 2014 09:57:36 +0400
Subject: [PATCH 3/3] emacs: Add support for displaying outputs.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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.
* 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-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): New procedures.
* 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): Describe "output-list".
(emacs Info buffer): Describe "output-info".
(emacs Buffer Names): New node.
(emacs Keymaps): Add keymaps for output buffers.
---
doc/emacs.texi | 77 +++++++++++++++++++++++++++++++-
emacs/guix-base.el | 61 +++++++++++++++++++++++++-
emacs/guix-info.el | 53 ++++++++++++++++++++--
emacs/guix-list.el | 126 ++++++++++++++++++++++++++++++++++++++++++++++++-----
emacs/guix.el | 12 ++---
5 files changed, 305 insertions(+), 24 deletions(-)
diff --git a/doc/emacs.texi b/doc/emacs.texi
index 7616c8f..328b1f3 100644
--- a/doc/emacs.texi
+++ b/doc/emacs.texi
@@ -104,6 +104,14 @@ many last generations.
@end table
+By default commands for displaying packages display a list with a
+package per line. If you prefer to see a list of outputs (i.e.@: a list
+with each output on a separate line), use the following setting:
+
+@example
+(setq guix-package-list-type 'output)
+@end example
+
It is possible to change the currently used profile with
@kbd{M-x@tie{}guix-set-current-profile}. This has the same effect as
specifying @code{--profile} option for @command{guix package}
@@ -191,6 +199,24 @@ Mark all obsolete packages for upgrading.
Execute actions on marked packages.
@end table
+An ``output-list'' buffer additionally provides the following bindings:
+
+@table @kbd
+@item @key{RET}
+Describe marked outputs (display available information in a
+``output-info'' buffer).
+@item i
+Mark the current output for installation.
+@item d
+Mark the current output for deletion.
+@item U
+Mark the current output for upgrading.
+@item ^
+Mark all obsolete outputs for upgrading.
+@item x
+Execute actions on marked outputs.
+@end table
+
A ``generation-list'' buffer additionally provides the following
bindings:
@@ -213,7 +239,7 @@ The interface of an ``info'' buffer is similar to the interface of
emacs, The Emacs Editor}) which can be used to:
@itemize @bullet
-@item (in a ``package-info'' buffer)
+@item (in a ``package-info'' or ``output-info'' buffer)
@itemize @minus
@item install/remove a package;
@@ -244,6 +270,7 @@ all) and faces.
@menu
* 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.
* Appearance: emacs Appearance. Settings for visual appearance.
@end menu
@@ -270,6 +297,48 @@ build}).
@end table
+@node emacs Buffer Names
+@subsubsection Buffer Names
+
+Default names of ``guix.el'' buffers (``*Guix@tie{}@dots{}*'') may be
+changed by 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 outputs and packages to be displayed in the same
+buffer, you may do it like this:
+
+@example
+(eval-after-load "guix.el"
+ '(setq guix-output-info-buffer-name guix-package-info-buffer-name
+ guix-output-list-buffer-name guix-package-list-buffer-name))
+@end example
+
+It is even possible to display all types of results in a single buffer
+(in such case you will probably use a history (@kbd{l}/@kbd{r})
+extensively):
+
+@example
+(let ((name "Guix Universal buffer"))
+ (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
@subsubsection Keymaps
@@ -283,6 +352,9 @@ Parent keymap with general keys for ``list'' buffers.
@item guix-package-list-mode-map
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
Keymap with specific keys for ``generation-list'' buffers.
@@ -292,6 +364,9 @@ Parent keymap with general keys for ``info'' buffers.
@item guix-package-info-mode-map
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
Keymap with specific keys for ``generation-info'' buffers.
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index 1959814..c393a4e 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -87,6 +87,22 @@ Interactively, prompt for PATH. With prefix, use
(path . "Installed path")
(dependencies . "Dependencies")
(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
(id . "ID")
(number . "Number")
@@ -130,6 +146,14 @@ Each element of the list has a form:
(equal id (guix-get-key-val entry 'id)))
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))))
+
\f
;;; Location of the packages
@@ -470,8 +494,8 @@ This function will not update the information, use
(many "%d newest available packages." count))
(installed
(0 "No installed packages.")
- (1 "A single installed package.")
- (many "%d installed packages." count))
+ (1 "A single package installed.")
+ (many "%d packages installed." count))
(obsolete
(0 "No obsolete packages.")
(1 "A single obsolete package.")
@@ -480,6 +504,39 @@ This function will not update the information, use
(0 "No packages installed in generation %d." val)
(1 "A single package installed in generation %d." 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
(id
(0 "Generations not found.")
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index 05281e7..db8be40 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -117,6 +117,23 @@ number of characters, it will be split into several lines.")
guix-info-insert-title-simple)
(dependencies guix-package-info-insert-output-dependencies
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
(number guix-generation-info-insert-number)
(path guix-info-insert-file-path)
@@ -141,6 +158,8 @@ argument.")
(defvar guix-info-displayed-params
'((package name version synopsis outputs location home-url
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)
(generation number prev-number time path))
"List of displayed entry parameters.
@@ -520,9 +539,37 @@ ENTRY is an alist with package info."
"Insert PATH of the installed output."
(guix-info-insert-val-simple path #'guix-info-insert-file-path))
-(defun guix-package-info-insert-output-dependencies (deps &optional _)
- "Insert dependencies DEPS of the installed output."
- (guix-info-insert-val-simple deps #'guix-info-insert-file-path))
+(defalias 'guix-package-info-insert-output-dependencies
+ 'guix-package-info-insert-output-path)
+
+\f
+;;; Displaying outputs
+
+(guix-define-buffer-type info output
+ :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))))
\f
;;; Displaying generations
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index 3732d9b..b9204da 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -55,6 +55,12 @@ entries, he will be prompted for confirmation."
(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))
@@ -82,6 +88,10 @@ this list have a priority.")
(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)))
@@ -456,6 +466,14 @@ With prefix (if ARG is non-nil), describe entries marked with any mark."
"Face used if a package is obsolete."
:group 'guix-package-list)
+(defcustom guix-package-list-type 'package
+ "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)."
+ :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'.
@@ -499,7 +517,8 @@ Colorize it with `guix-package-list-installed' or
(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'")))
@@ -563,9 +582,10 @@ be separated with \",\")."
(and arg "Output(s) to upgrade: ")
installed))))
-(defun guix-package-list-mark-upgrades ()
- "Mark all obsolete packages for upgrading."
- (interactive)
+(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)
@@ -579,20 +599,32 @@ be separated with \",\")."
(equal id (guix-get-key-val entry 'id)))
obsolete)))
(when entry
- (apply #'guix-list-mark
- 'upgrade nil
- (guix-get-installed-outputs entry))))))))
+ (funcall fun entry)))))))
-(defun guix-package-list-execute ()
- "Perform actions on the marked packages."
+(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.
@@ -601,6 +633,76 @@ The specification is suitable for `guix-process-package-actions'."
(and specs (cons action-type specs))))
\f
+;;; Displaying outputs
+
+(guix-define-buffer-type list output)
+
+(guix-list-define-entry-type output
+ :sort-key name
+ :marks ((install . ?I)
+ (upgrade . ?U)
+ (delete . ?D)))
+
+(let ((map guix-output-list-mode-map))
+ (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)))))
+
+\f
;;; Displaying generations
(guix-define-buffer-type list generation)
@@ -618,7 +720,7 @@ The specification is suitable for `guix-process-package-actions'."
(defun guix-generation-list-show-packages ()
"List installed packages for the generation at point."
(interactive)
- (guix-get-show-entries 'list 'package 'generation
+ (guix-get-show-entries 'list guix-package-list-type 'generation
(guix-list-current-id)))
(provide 'guix-list)
diff --git a/emacs/guix.el b/emacs/guix.el
index 621dd3b..f6e2023 100644
--- a/emacs/guix.el
+++ b/emacs/guix.el
@@ -58,24 +58,24 @@ SEARCH-VALS.
Results are displayed in the list buffer, unless a single package
is found and `guix-list-single-package' is nil."
(let* ((list-params (guix-get-params-for-receiving
- 'list 'package))
- (packages (guix-get-entries 'package
+ 'list guix-package-list-type))
+ (packages (guix-get-entries guix-package-list-type
search-type search-vals
list-params)))
(if (or guix-list-single-package
(cdr packages))
- (guix-set-buffer packages 'list 'package
+ (guix-set-buffer packages 'list guix-package-list-type
search-type search-vals)
(let* ((info-params (guix-get-params-for-receiving
- 'info 'package))
+ 'info guix-package-list-type))
(packages (if (equal list-params info-params)
packages
;; If we don't have required info, we should
;; receive it again
- (guix-get-entries 'package
+ (guix-get-entries guix-package-list-type
search-type search-vals
info-params))))
- (guix-set-buffer packages 'info 'package
+ (guix-set-buffer packages 'info guix-package-list-type
search-type search-vals)))))
(defun guix-get-show-generations (search-type &rest search-vals)
--
2.1.0
next prev parent reply other threads:[~2014-09-19 6:59 UTC|newest]
Thread overview: 28+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-09-05 7:42 guix.el: Key bindings for a "package list" Alex Kost
2014-09-05 8:26 ` Ludovic Courtès
2014-09-05 12:37 ` Alex Kost
2014-09-05 20:22 ` Ludovic Courtès
2014-09-06 16:45 ` Alex Kost
2014-09-06 17:28 ` Taylan Ulrich Bayirli/Kammer
2014-09-06 21:11 ` guix.el & multiple outputs Ludovic Courtès
2014-09-06 22:39 ` Taylan Ulrich Bayirli/Kammer
2014-09-08 6:50 ` Ludovic Courtès
2014-09-07 16:14 ` Alex Kost
2014-09-19 6:58 ` Alex Kost [this message]
2014-09-20 14:11 ` [PATCH] emacs: Rewrite scheme side in a functional manner Ludovic Courtès
2014-09-21 10:51 ` Alex Kost
2014-09-21 19:27 ` Ludovic Courtès
2014-09-23 20:14 ` Alex Kost
2014-09-24 7:48 ` Ludovic Courtès
2014-09-21 19:28 ` ‘profile-generations’ Ludovic Courtès
2014-09-21 19:37 ` guix.el & multiple outputs Ludovic Courtès
2014-09-23 20:14 ` Alex Kost
2014-09-24 7:50 ` Ludovic Courtès
2014-09-06 21:15 ` guix.el: Key bindings for a "package list" Ludovic Courtès
2014-09-07 16:14 ` Alex Kost
2014-09-08 6:51 ` Ludovic Courtès
2014-09-05 9:11 ` Taylan Ulrich Bayirli/Kammer
2014-09-05 12:37 ` Alex Kost
2014-09-05 20:24 ` Ludovic Courtès
2014-09-06 8:17 ` Alex Kost
2014-09-06 10:55 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87sijodrl2.fsf@gmail.com \
--to=alezost@gmail.com \
--cc=guix-devel@gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.