M emacs.am => emacs.am +1 -0
@@ 25,6 25,7 @@ ELFILES = \
emacs/guix-command.el \
emacs/guix-devel.el \
emacs/guix-emacs.el \
+ emacs/guix-entry.el \
emacs/guix-external.el \
emacs/guix-geiser.el \
emacs/guix-guile.el \
M emacs/guix-base.el => emacs/guix-base.el +10 -15
@@ 30,6 30,7 @@
(require 'cl-lib)
(require 'guix-profiles)
(require 'guix-backend)
+(require 'guix-entry)
(require 'guix-guile)
(require 'guix-utils)
(require 'guix-history)
@@ 103,15 104,15 @@ Each element of the list has a form:
(defun guix-get-full-name (entry &optional output)
"Return name specification of the package ENTRY and OUTPUT."
- (guix-get-name-spec (guix-assq-value entry 'name)
- (guix-assq-value entry 'version)
+ (guix-get-name-spec (guix-entry-value entry 'name)
+ (guix-entry-value entry 'version)
output))
(defun guix-entry-to-specification (entry)
"Return name specification by the package or output ENTRY."
- (guix-get-name-spec (guix-assq-value entry 'name)
- (guix-assq-value entry 'version)
- (guix-assq-value entry 'output)))
+ (guix-get-name-spec (guix-entry-value entry 'name)
+ (guix-entry-value entry 'version)
+ (guix-entry-value entry 'output)))
(defun guix-entries-to-specifications (entries)
"Return name specifications by the package or output ENTRIES."
@@ 121,14 122,8 @@ Each element of the list has a form:
(defun guix-get-installed-outputs (entry)
"Return list of installed outputs for the package ENTRY."
(mapcar (lambda (installed-entry)
- (guix-assq-value installed-entry 'output))
- (guix-assq-value entry 'installed)))
-
-(defun guix-get-entry-by-id (id entries)
- "Return entry from ENTRIES by entry ID."
- (cl-find-if (lambda (entry)
- (equal id (guix-assq-value entry 'id)))
- entries))
+ (guix-entry-value installed-entry 'output))
+ (guix-entry-value entry 'installed)))
(defun guix-get-package-id-and-output-by-output-id (oid)
"Return list (PACKAGE-ID OUTPUT) by output id OID."
@@ 940,9 935,9 @@ ENTRIES is a list of package entries to get info about packages."
(lambda (spec)
(let* ((id (car spec))
(outputs (cdr spec))
- (entry (guix-get-entry-by-id id entries)))
+ (entry (guix-entry-by-id id entries)))
(when entry
- (let ((location (guix-assq-value entry 'location)))
+ (let ((location (guix-entry-value entry 'location)))
(concat (guix-get-full-name entry)
(when outputs
(concat ":"
A emacs/guix-entry.el => emacs/guix-entry.el +59 -0
@@ 0,0 1,59 @@
+;;; guix-entry.el --- 'Entry' type -*- lexical-binding: t -*-
+
+;; Copyright © 2015 Alex Kost <alezost@gmail.com>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides an API for 'entry' type which is just an alist of
+;; KEY/VALUE pairs (KEY should be a symbol) with the required 'id' KEY.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'guix-utils)
+
+(defalias 'guix-entry-value #'guix-assq-value)
+
+(defun guix-entry-id (entry)
+ "Return ENTRY ID."
+ (guix-entry-value entry 'id))
+
+(defun guix-entry-by-id (id entries)
+ "Return an entry from ENTRIES by its ID."
+ (cl-find-if (lambda (entry)
+ (equal (guix-entry-id entry) id))
+ entries))
+
+(defun guix-entries-by-ids (ids entries)
+ "Return entries with IDS (a list of identifiers) from ENTRIES."
+ (cl-remove-if-not (lambda (entry)
+ (member (guix-entry-id entry) ids))
+ entries))
+
+(defun guix-replace-entry (id new-entry entries)
+ "Replace an entry with ID from ENTRIES by NEW-ENTRY.
+Return a list of entries with the replaced entry."
+ (cl-substitute-if new-entry
+ (lambda (entry)
+ (equal id (guix-entry-id entry)))
+ entries
+ :count 1))
+
+(provide 'guix-entry)
+
+;;; guix-entry.el ends here
M emacs/guix-info.el => emacs/guix-info.el +22 -27
@@ 26,6 26,7 @@
;;; Code:
(require 'guix-base)
+(require 'guix-entry)
(require 'guix-utils)
(defgroup guix-info nil
@@ 241,7 242,7 @@ Use `guix-info-insert-ENTRY-TYPE-function' or
"Insert title and value of a PARAM at point.
ENTRY is alist with parameters and their values.
ENTRY-TYPE is a type of ENTRY."
- (let ((val (guix-assq-value entry param)))
+ (let ((val (guix-entry-value entry param)))
(unless (and guix-info-ignore-empty-vals (null val))
(let* ((title (guix-get-param-title entry-type param))
(insert-methods (guix-info-get-insert-methods entry-type param))
@@ 500,12 501,12 @@ filling them to fit the window."
(defun guix-package-info-insert-heading (entry)
"Insert the heading for package ENTRY.
Show package name, version, and `guix-package-info-heading-params'."
- (guix-format-insert (concat (guix-assq-value entry 'name) " "
- (guix-assq-value entry 'version))
+ (guix-format-insert (concat (guix-entry-value entry 'name) " "
+ (guix-entry-value entry 'version))
'guix-package-info-heading)
(insert "\n\n")
(mapc (lambda (param)
- (let ((val (guix-assq-value entry param))
+ (let ((val (guix-entry-value entry param))
(face (guix-get-symbol (symbol-name param)
'info 'package)))
(when val
@@ 595,10 596,10 @@ If nil, insert installed info in a default way.")
(defun guix-package-info-insert-outputs (outputs entry)
"Insert OUTPUTS from package ENTRY at point."
- (and (guix-assq-value entry 'obsolete)
+ (and (guix-entry-value entry 'obsolete)
(guix-package-info-insert-obsolete-text))
- (and (guix-assq-value entry 'non-unique)
- (guix-assq-value entry 'installed)
+ (and (guix-entry-value entry 'non-unique)
+ (guix-entry-value entry 'installed)
(guix-package-info-insert-non-unique-text
(guix-get-full-name entry)))
(insert "\n")
@@ 625,11 626,11 @@ If nil, insert installed info in a default way.")
Make some fancy text with buttons and additional stuff if the
current OUTPUT is installed (if there is such output in
`installed' parameter of a package ENTRY)."
- (let* ((installed (guix-assq-value entry 'installed))
- (obsolete (guix-assq-value entry 'obsolete))
+ (let* ((installed (guix-entry-value entry 'installed))
+ (obsolete (guix-entry-value entry 'obsolete))
(installed-entry (cl-find-if
(lambda (entry)
- (string= (guix-assq-value entry 'output)
+ (string= (guix-entry-value entry 'output)
output))
installed))
(action-type (if installed-entry 'delete 'install)))
@@ 663,8 664,8 @@ ENTRY is an alist with package info."
(current-buffer)))
(concat type-str " '" full-name "'")
'action-type type
- 'id (or (guix-assq-value entry 'package-id)
- (guix-assq-value entry 'id))
+ 'id (or (guix-entry-value entry 'package-id)
+ (guix-entry-id entry))
'output output)))
(defun guix-package-info-insert-output-path (path &optional _)
@@ 719,19 720,13 @@ prompt depending on `guix-operation-confirm' variable)."
Find the file if needed (see `guix-package-info-auto-find-source').
ENTRY-ID is an ID of the current entry (package or output).
PACKAGE-ID is an ID of the package which source to show."
- (let* ((entry (guix-get-entry-by-id entry-id guix-entries))
+ (let* ((entry (guix-entry-by-id entry-id guix-entries))
(file (guix-package-source-path package-id)))
(or file
(error "Couldn't define file path of the package source"))
(let* ((new-entry (cons (cons 'source-file file)
entry))
- (entries (cl-substitute-if
- new-entry
- (lambda (entry)
- (equal (guix-assq-value entry 'id)
- entry-id))
- guix-entries
- :count 1)))
+ (entries (guix-replace-entry entry-id new-entry guix-entries)))
(guix-redisplay-buffer :entries entries)
(if (file-exists-p file)
(if guix-package-info-auto-find-source
@@ 754,9 749,9 @@ SOURCE is a list of URLs."
(guix-info-insert-indent)
(if (null source)
(guix-format-insert nil)
- (let* ((source-file (guix-assq-value entry 'source-file))
- (entry-id (guix-assq-value entry 'id))
- (package-id (or (guix-assq-value entry 'package-id)
+ (let* ((source-file (guix-entry-value entry 'source-file))
+ (entry-id (guix-entry-id entry))
+ (package-id (or (guix-entry-value entry 'package-id)
entry-id)))
(if (null source-file)
(guix-info-insert-action-button
@@ 806,13 801,13 @@ If nil, insert output in a default way.")
"Insert output VERSION and obsolete text if needed at point."
(guix-info-insert-val-default version
'guix-package-info-version)
- (and (guix-assq-value entry 'obsolete)
+ (and (guix-entry-value 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-assq-value entry 'installed))
- (obsolete (guix-assq-value entry 'obsolete))
+ (let* ((installed (guix-entry-value entry 'installed))
+ (obsolete (guix-entry-value entry 'obsolete))
(action-type (if installed 'delete 'install)))
(guix-info-insert-val-default
output
@@ 882,7 877,7 @@ If nil, insert generation in a default way.")
(guix-switch-to-generation guix-profile (button-get btn 'number)
(current-buffer)))
"Switch to this generation (make it the current one)"
- 'number (guix-assq-value entry 'number))))
+ 'number (guix-entry-value entry 'number))))
(provide 'guix-info)
M emacs/guix-list.el => emacs/guix-list.el +18 -17
@@ 28,6 28,7 @@
(require 'tabulated-list)
(require 'guix-info)
(require 'guix-base)
+(require 'guix-entry)
(require 'guix-utils)
(defgroup guix-list nil
@@ 180,7 181,7 @@ ENTRIES should have a form of `guix-entries'."
Values are taken from ENTRIES which should have the form of
`guix-entries'."
(mapcar (lambda (entry)
- (list (guix-assq-value entry 'id)
+ (list (guix-entry-id entry)
(guix-list-get-tabulated-entry entry entry-type)))
entries))
@@ 190,7 191,7 @@ Parameters are taken from ENTRY of ENTRY-TYPE."
(guix-list-make-tabulated-vector
entry-type
(lambda (param _)
- (let ((val (guix-assq-value entry param))
+ (let ((val (guix-entry-value entry param))
(fun (guix-assq-value guix-list-column-value-methods
entry-type param)))
(if fun
@@ 224,7 225,7 @@ VAL may be nil."
(defun guix-list-current-entry ()
"Return alist of the current entry info."
- (guix-get-entry-by-id (guix-list-current-id) guix-entries))
+ (guix-entry-by-id (guix-list-current-id) guix-entries))
(defun guix-list-current-package-id ()
"Return ID of the current package."
@@ 232,7 233,7 @@ VAL may be nil."
(guix-package-list-mode
(guix-list-current-id))
(guix-output-list-mode
- (guix-assq-value (guix-list-current-entry) 'package-id))))
+ (guix-entry-value (guix-list-current-entry) 'package-id))))
(defun guix-list-for-each-line (fun &rest args)
"Call FUN with ARGS for each entry line."
@@ 535,16 536,16 @@ likely)."
Colorize it with `guix-package-list-installed' or
`guix-package-list-obsolete' if needed."
(guix-get-string name
- (cond ((guix-assq-value entry 'obsolete)
+ (cond ((guix-entry-value entry 'obsolete)
'guix-package-list-obsolete)
- ((guix-assq-value entry 'installed)
+ ((guix-entry-value entry 'installed)
'guix-package-list-installed))))
(defun guix-package-list-get-installed-outputs (installed &optional _)
"Return string with outputs from INSTALLED entries."
(guix-get-string
(mapcar (lambda (entry)
- (guix-assq-value entry 'output))
+ (guix-entry-value entry 'output))
installed)))
(defun guix-package-list-marking-check ()
@@ 573,7 574,7 @@ be separated with \",\")."
(interactive "P")
(guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry))
- (all (guix-assq-value entry 'outputs))
+ (all (guix-entry-value entry 'outputs))
(installed (guix-get-installed-outputs entry))
(available (cl-set-difference all installed :test #'string=)))
(or available
@@ 608,7 609,7 @@ be separated with \",\")."
(installed (guix-get-installed-outputs entry)))
(or installed
(user-error "This package is not installed"))
- (when (or (guix-assq-value entry 'obsolete)
+ (when (or (guix-entry-value entry 'obsolete)
(y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
(guix-package-list-mark-outputs
'upgrade installed
@@ 622,14 623,14 @@ accept an entry as argument."
(guix-package-list-marking-check)
(let ((obsolete (cl-remove-if-not
(lambda (entry)
- (guix-assq-value entry 'obsolete))
+ (guix-entry-value entry 'obsolete))
guix-entries)))
(guix-list-for-each-line
(lambda ()
(let* ((id (guix-list-current-id))
(entry (cl-find-if
(lambda (entry)
- (equal id (guix-assq-value entry 'id)))
+ (equal id (guix-entry-id entry)))
obsolete)))
(when entry
(funcall fun entry)))))))
@@ 693,7 694,7 @@ The specification is suitable for `guix-process-package-actions'."
(interactive)
(guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry))
- (installed (guix-assq-value entry 'installed)))
+ (installed (guix-entry-value entry 'installed)))
(if installed
(user-error "This output is already installed")
(guix-list--mark 'install t))))
@@ 703,7 704,7 @@ The specification is suitable for `guix-process-package-actions'."
(interactive)
(guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry))
- (installed (guix-assq-value entry 'installed)))
+ (installed (guix-entry-value entry 'installed)))
(if installed
(guix-list--mark 'delete t)
(user-error "This output is not installed"))))
@@ 713,10 714,10 @@ The specification is suitable for `guix-process-package-actions'."
(interactive)
(guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry))
- (installed (guix-assq-value entry 'installed)))
+ (installed (guix-entry-value entry 'installed)))
(or installed
(user-error "This output is not installed"))
- (when (or (guix-assq-value entry 'obsolete)
+ (when (or (guix-entry-value entry 'obsolete)
(y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
(guix-list--mark 'upgrade t))))
@@ 788,8 789,8 @@ VAL is a boolean value."
"Switch current profile to the generation at point."
(interactive)
(let* ((entry (guix-list-current-entry))
- (current (guix-assq-value entry 'current))
- (number (guix-assq-value entry 'number)))
+ (current (guix-entry-value entry 'current))
+ (number (guix-entry-value entry 'number)))
(if current
(user-error "This generation is already the current one")
(guix-switch-to-generation guix-profile number (current-buffer)))))