summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2015-10-22 10:08:42 +0300
committerAlex Kost <alezost@gmail.com>2016-01-02 17:25:35 +0300
commit73ce3c19c435db51ec818ec62a75e0956b31899f (patch)
tree3ab30fc747bde31f48000fd1d622b8618aa2d8b8
parent36c00c61fa257f5177ba9bc54a2d57191b70909f (diff)
downloadpatches-73ce3c19c435db51ec818ec62a75e0956b31899f.tar
patches-73ce3c19c435db51ec818ec62a75e0956b31899f.tar.gz
emacs: Add API for 'guix-entry'.
* emacs/guix-info.el: Use new entry procedures. * emacs/guix-list.el: Likewise. * emacs/guix-base.el: Likewise. (guix-get-entry-by-id): Move and rename to ... * emacs/guix-entry.el (guix-entry-by-id): ...this. New file. (guix-entry-value, guix-entry-id, guix-entries-by-ids) (guix-replace-entry): New procedures. * emacs.am (ELFILES): Add new file.
-rw-r--r--emacs.am1
-rw-r--r--emacs/guix-base.el25
-rw-r--r--emacs/guix-entry.el59
-rw-r--r--emacs/guix-info.el49
-rw-r--r--emacs/guix-list.el35
5 files changed, 110 insertions, 59 deletions
diff --git a/emacs.am b/emacs.am
index 9f300bfc07..a205b0a359 100644
--- a/emacs.am
+++ b/emacs.am
@@ -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 \
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index d9c70aae9e..7055a0984e 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -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 ":"
diff --git a/emacs/guix-entry.el b/emacs/guix-entry.el
new file mode 100644
index 0000000000..5eed2ed015
--- /dev/null
+++ b/emacs/guix-entry.el
@@ -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
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index c9054e18be..8cb4e94185 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -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)
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index 560ae6a86f..6bb8571635 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -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)))))