diff options
| -rw-r--r-- | emacs.am | 1 | ||||
| -rw-r--r-- | emacs/guix-base.el | 25 | ||||
| -rw-r--r-- | emacs/guix-entry.el | 59 | ||||
| -rw-r--r-- | emacs/guix-info.el | 49 | ||||
| -rw-r--r-- | emacs/guix-list.el | 35 |
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))))) |