futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

emacs: Add API for 'guix-entry'.

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
emacs.am
View File

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

25
emacs/guix-base.el
View File

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

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

49
emacs/guix-info.el
View File

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

35
emacs/guix-list.el
View File

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