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.
This commit is contained in:
Alex Kost 2015-10-22 10:08:42 +03:00
parent 36c00c61fa
commit 73ce3c19c4
5 changed files with 110 additions and 59 deletions

View File

@ -25,6 +25,7 @@ ELFILES = \
emacs/guix-command.el \ emacs/guix-command.el \
emacs/guix-devel.el \ emacs/guix-devel.el \
emacs/guix-emacs.el \ emacs/guix-emacs.el \
emacs/guix-entry.el \
emacs/guix-external.el \ emacs/guix-external.el \
emacs/guix-geiser.el \ emacs/guix-geiser.el \
emacs/guix-guile.el \ emacs/guix-guile.el \

View File

@ -30,6 +30,7 @@
(require 'cl-lib) (require 'cl-lib)
(require 'guix-profiles) (require 'guix-profiles)
(require 'guix-backend) (require 'guix-backend)
(require 'guix-entry)
(require 'guix-guile) (require 'guix-guile)
(require 'guix-utils) (require 'guix-utils)
(require 'guix-history) (require 'guix-history)
@ -103,15 +104,15 @@ Each element of the list has a form:
(defun guix-get-full-name (entry &optional output) (defun guix-get-full-name (entry &optional output)
"Return name specification of the package ENTRY and OUTPUT." "Return name specification of the package ENTRY and OUTPUT."
(guix-get-name-spec (guix-assq-value entry 'name) (guix-get-name-spec (guix-entry-value entry 'name)
(guix-assq-value entry 'version) (guix-entry-value entry 'version)
output)) output))
(defun guix-entry-to-specification (entry) (defun guix-entry-to-specification (entry)
"Return name specification by the package or output ENTRY." "Return name specification by the package or output ENTRY."
(guix-get-name-spec (guix-assq-value entry 'name) (guix-get-name-spec (guix-entry-value entry 'name)
(guix-assq-value entry 'version) (guix-entry-value entry 'version)
(guix-assq-value entry 'output))) (guix-entry-value entry 'output)))
(defun guix-entries-to-specifications (entries) (defun guix-entries-to-specifications (entries)
"Return name specifications by the package or output 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) (defun guix-get-installed-outputs (entry)
"Return list of installed outputs for the package ENTRY." "Return list of installed outputs for the package ENTRY."
(mapcar (lambda (installed-entry) (mapcar (lambda (installed-entry)
(guix-assq-value installed-entry 'output)) (guix-entry-value installed-entry 'output))
(guix-assq-value entry 'installed))) (guix-entry-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))
(defun guix-get-package-id-and-output-by-output-id (oid) (defun guix-get-package-id-and-output-by-output-id (oid)
"Return list (PACKAGE-ID 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) (lambda (spec)
(let* ((id (car spec)) (let* ((id (car spec))
(outputs (cdr spec)) (outputs (cdr spec))
(entry (guix-get-entry-by-id id entries))) (entry (guix-entry-by-id id entries)))
(when entry (when entry
(let ((location (guix-assq-value entry 'location))) (let ((location (guix-entry-value entry 'location)))
(concat (guix-get-full-name entry) (concat (guix-get-full-name entry)
(when outputs (when outputs
(concat ":" (concat ":"

59
emacs/guix-entry.el Normal file
View File

@ -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

View File

@ -26,6 +26,7 @@
;;; Code: ;;; Code:
(require 'guix-base) (require 'guix-base)
(require 'guix-entry)
(require 'guix-utils) (require 'guix-utils)
(defgroup guix-info nil (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. "Insert title and value of a PARAM at point.
ENTRY is alist with parameters and their values. ENTRY is alist with parameters and their values.
ENTRY-TYPE is a type of ENTRY." 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)) (unless (and guix-info-ignore-empty-vals (null val))
(let* ((title (guix-get-param-title entry-type param)) (let* ((title (guix-get-param-title entry-type param))
(insert-methods (guix-info-get-insert-methods 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) (defun guix-package-info-insert-heading (entry)
"Insert the heading for package ENTRY. "Insert the heading for package ENTRY.
Show package name, version, and `guix-package-info-heading-params'." Show package name, version, and `guix-package-info-heading-params'."
(guix-format-insert (concat (guix-assq-value entry 'name) " " (guix-format-insert (concat (guix-entry-value entry 'name) " "
(guix-assq-value entry 'version)) (guix-entry-value entry 'version))
'guix-package-info-heading) 'guix-package-info-heading)
(insert "\n\n") (insert "\n\n")
(mapc (lambda (param) (mapc (lambda (param)
(let ((val (guix-assq-value entry param)) (let ((val (guix-entry-value entry param))
(face (guix-get-symbol (symbol-name param) (face (guix-get-symbol (symbol-name param)
'info 'package))) 'info 'package)))
(when val (when val
@ -595,10 +596,10 @@ If nil, insert installed info in a default way.")
(defun guix-package-info-insert-outputs (outputs entry) (defun guix-package-info-insert-outputs (outputs entry)
"Insert OUTPUTS from package ENTRY at point." "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)) (guix-package-info-insert-obsolete-text))
(and (guix-assq-value entry 'non-unique) (and (guix-entry-value entry 'non-unique)
(guix-assq-value entry 'installed) (guix-entry-value entry 'installed)
(guix-package-info-insert-non-unique-text (guix-package-info-insert-non-unique-text
(guix-get-full-name entry))) (guix-get-full-name entry)))
(insert "\n") (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 Make some fancy text with buttons and additional stuff if the
current OUTPUT is installed (if there is such output in current OUTPUT is installed (if there is such output in
`installed' parameter of a package ENTRY)." `installed' parameter of a package ENTRY)."
(let* ((installed (guix-assq-value entry 'installed)) (let* ((installed (guix-entry-value entry 'installed))
(obsolete (guix-assq-value entry 'obsolete)) (obsolete (guix-entry-value entry 'obsolete))
(installed-entry (cl-find-if (installed-entry (cl-find-if
(lambda (entry) (lambda (entry)
(string= (guix-assq-value entry 'output) (string= (guix-entry-value entry 'output)
output)) output))
installed)) installed))
(action-type (if installed-entry 'delete 'install))) (action-type (if installed-entry 'delete 'install)))
@ -663,8 +664,8 @@ ENTRY is an alist with package info."
(current-buffer))) (current-buffer)))
(concat type-str " '" full-name "'") (concat type-str " '" full-name "'")
'action-type type 'action-type type
'id (or (guix-assq-value entry 'package-id) 'id (or (guix-entry-value entry 'package-id)
(guix-assq-value entry 'id)) (guix-entry-id entry))
'output output))) 'output output)))
(defun guix-package-info-insert-output-path (path &optional _) (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'). Find the file if needed (see `guix-package-info-auto-find-source').
ENTRY-ID is an ID of the current entry (package or output). ENTRY-ID is an ID of the current entry (package or output).
PACKAGE-ID is an ID of the package which source to show." 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))) (file (guix-package-source-path package-id)))
(or file (or file
(error "Couldn't define file path of the package source")) (error "Couldn't define file path of the package source"))
(let* ((new-entry (cons (cons 'source-file file) (let* ((new-entry (cons (cons 'source-file file)
entry)) entry))
(entries (cl-substitute-if (entries (guix-replace-entry entry-id new-entry guix-entries)))
new-entry
(lambda (entry)
(equal (guix-assq-value entry 'id)
entry-id))
guix-entries
:count 1)))
(guix-redisplay-buffer :entries entries) (guix-redisplay-buffer :entries entries)
(if (file-exists-p file) (if (file-exists-p file)
(if guix-package-info-auto-find-source (if guix-package-info-auto-find-source
@ -754,9 +749,9 @@ SOURCE is a list of URLs."
(guix-info-insert-indent) (guix-info-insert-indent)
(if (null source) (if (null source)
(guix-format-insert nil) (guix-format-insert nil)
(let* ((source-file (guix-assq-value entry 'source-file)) (let* ((source-file (guix-entry-value entry 'source-file))
(entry-id (guix-assq-value entry 'id)) (entry-id (guix-entry-id entry))
(package-id (or (guix-assq-value entry 'package-id) (package-id (or (guix-entry-value entry 'package-id)
entry-id))) entry-id)))
(if (null source-file) (if (null source-file)
(guix-info-insert-action-button (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." "Insert output VERSION and obsolete text if needed at point."
(guix-info-insert-val-default version (guix-info-insert-val-default version
'guix-package-info-version) 'guix-package-info-version)
(and (guix-assq-value entry 'obsolete) (and (guix-entry-value entry 'obsolete)
(guix-package-info-insert-obsolete-text))) (guix-package-info-insert-obsolete-text)))
(defun guix-output-info-insert-output (output entry) (defun guix-output-info-insert-output (output entry)
"Insert OUTPUT and action buttons at point." "Insert OUTPUT and action buttons at point."
(let* ((installed (guix-assq-value entry 'installed)) (let* ((installed (guix-entry-value entry 'installed))
(obsolete (guix-assq-value entry 'obsolete)) (obsolete (guix-entry-value entry 'obsolete))
(action-type (if installed 'delete 'install))) (action-type (if installed 'delete 'install)))
(guix-info-insert-val-default (guix-info-insert-val-default
output output
@ -882,7 +877,7 @@ If nil, insert generation in a default way.")
(guix-switch-to-generation guix-profile (button-get btn 'number) (guix-switch-to-generation guix-profile (button-get btn 'number)
(current-buffer))) (current-buffer)))
"Switch to this generation (make it the current one)" "Switch to this generation (make it the current one)"
'number (guix-assq-value entry 'number)))) 'number (guix-entry-value entry 'number))))
(provide 'guix-info) (provide 'guix-info)

View File

@ -28,6 +28,7 @@
(require 'tabulated-list) (require 'tabulated-list)
(require 'guix-info) (require 'guix-info)
(require 'guix-base) (require 'guix-base)
(require 'guix-entry)
(require 'guix-utils) (require 'guix-utils)
(defgroup guix-list nil (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 Values are taken from ENTRIES which should have the form of
`guix-entries'." `guix-entries'."
(mapcar (lambda (entry) (mapcar (lambda (entry)
(list (guix-assq-value entry 'id) (list (guix-entry-id entry)
(guix-list-get-tabulated-entry entry entry-type))) (guix-list-get-tabulated-entry entry entry-type)))
entries)) entries))
@ -190,7 +191,7 @@ Parameters are taken from ENTRY of ENTRY-TYPE."
(guix-list-make-tabulated-vector (guix-list-make-tabulated-vector
entry-type entry-type
(lambda (param _) (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 (fun (guix-assq-value guix-list-column-value-methods
entry-type param))) entry-type param)))
(if fun (if fun
@ -224,7 +225,7 @@ VAL may be nil."
(defun guix-list-current-entry () (defun guix-list-current-entry ()
"Return alist of the current entry info." "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 () (defun guix-list-current-package-id ()
"Return ID of the current package." "Return ID of the current package."
@ -232,7 +233,7 @@ VAL may be nil."
(guix-package-list-mode (guix-package-list-mode
(guix-list-current-id)) (guix-list-current-id))
(guix-output-list-mode (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) (defun guix-list-for-each-line (fun &rest args)
"Call FUN with ARGS for each entry line." "Call FUN with ARGS for each entry line."
@ -535,16 +536,16 @@ likely)."
Colorize it with `guix-package-list-installed' or Colorize it with `guix-package-list-installed' or
`guix-package-list-obsolete' if needed." `guix-package-list-obsolete' if needed."
(guix-get-string name (guix-get-string name
(cond ((guix-assq-value entry 'obsolete) (cond ((guix-entry-value entry 'obsolete)
'guix-package-list-obsolete) 'guix-package-list-obsolete)
((guix-assq-value entry 'installed) ((guix-entry-value entry 'installed)
'guix-package-list-installed)))) 'guix-package-list-installed))))
(defun guix-package-list-get-installed-outputs (installed &optional _) (defun guix-package-list-get-installed-outputs (installed &optional _)
"Return string with outputs from INSTALLED entries." "Return string with outputs from INSTALLED entries."
(guix-get-string (guix-get-string
(mapcar (lambda (entry) (mapcar (lambda (entry)
(guix-assq-value entry 'output)) (guix-entry-value entry 'output))
installed))) installed)))
(defun guix-package-list-marking-check () (defun guix-package-list-marking-check ()
@ -573,7 +574,7 @@ be separated with \",\")."
(interactive "P") (interactive "P")
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(all (guix-assq-value entry 'outputs)) (all (guix-entry-value entry 'outputs))
(installed (guix-get-installed-outputs entry)) (installed (guix-get-installed-outputs entry))
(available (cl-set-difference all installed :test #'string=))) (available (cl-set-difference all installed :test #'string=)))
(or available (or available
@ -608,7 +609,7 @@ be separated with \",\")."
(installed (guix-get-installed-outputs entry))) (installed (guix-get-installed-outputs entry)))
(or installed (or installed
(user-error "This package is not 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? ")) (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
(guix-package-list-mark-outputs (guix-package-list-mark-outputs
'upgrade installed 'upgrade installed
@ -622,14 +623,14 @@ accept an entry as argument."
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let ((obsolete (cl-remove-if-not (let ((obsolete (cl-remove-if-not
(lambda (entry) (lambda (entry)
(guix-assq-value entry 'obsolete)) (guix-entry-value entry 'obsolete))
guix-entries))) guix-entries)))
(guix-list-for-each-line (guix-list-for-each-line
(lambda () (lambda ()
(let* ((id (guix-list-current-id)) (let* ((id (guix-list-current-id))
(entry (cl-find-if (entry (cl-find-if
(lambda (entry) (lambda (entry)
(equal id (guix-assq-value entry 'id))) (equal id (guix-entry-id entry)))
obsolete))) obsolete)))
(when entry (when entry
(funcall fun entry))))))) (funcall fun entry)))))))
@ -693,7 +694,7 @@ The specification is suitable for `guix-process-package-actions'."
(interactive) (interactive)
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(installed (guix-assq-value entry 'installed))) (installed (guix-entry-value entry 'installed)))
(if installed (if installed
(user-error "This output is already installed") (user-error "This output is already installed")
(guix-list--mark 'install t)))) (guix-list--mark 'install t))))
@ -703,7 +704,7 @@ The specification is suitable for `guix-process-package-actions'."
(interactive) (interactive)
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(installed (guix-assq-value entry 'installed))) (installed (guix-entry-value entry 'installed)))
(if installed (if installed
(guix-list--mark 'delete t) (guix-list--mark 'delete t)
(user-error "This output is not installed")))) (user-error "This output is not installed"))))
@ -713,10 +714,10 @@ The specification is suitable for `guix-process-package-actions'."
(interactive) (interactive)
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(installed (guix-assq-value entry 'installed))) (installed (guix-entry-value entry 'installed)))
(or installed (or installed
(user-error "This output is not 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? ")) (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
(guix-list--mark 'upgrade t)))) (guix-list--mark 'upgrade t))))
@ -788,8 +789,8 @@ VAL is a boolean value."
"Switch current profile to the generation at point." "Switch current profile to the generation at point."
(interactive) (interactive)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(current (guix-assq-value entry 'current)) (current (guix-entry-value entry 'current))
(number (guix-assq-value entry 'number))) (number (guix-entry-value entry 'number)))
(if current (if current
(user-error "This generation is already the current one") (user-error "This generation is already the current one")
(guix-switch-to-generation guix-profile number (current-buffer))))) (guix-switch-to-generation guix-profile number (current-buffer)))))