03/38: emacs: Add API for 'guix-entry'.

[Alex Kost]

alezost pushed a commit to branch master
in repository guix.

commit 73ce3c19c435db51ec818ec62a75e0956b31899f
Author: Alex Kost <address@hidden>
Date:   Thu Oct 22 10:08:42 2015 +0300

    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.
---
 emacs.am            |    1 +
 emacs/guix-base.el  |   25 ++++++++-------------
 emacs/guix-entry.el |   59 +++++++++++++++++++++++++++++++++++++++++++++++++++
 emacs/guix-info.el  |   49 +++++++++++++++++++-----------------------
 emacs/guix-list.el  |   35 +++++++++++++++--------------
 5 files changed, 110 insertions(+), 59 deletions(-)

diff --git a/emacs.am b/emacs.am
index 9f300bf..a205b0a 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 d9c70aa..7055a09 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 0000000..5eed2ed
--- /dev/null
+++ b/emacs/guix-entry.el
@@ -0,0 +1,59 @@
+;;; guix-entry.el --- 'Entry' type  -*- lexical-binding: t -*-
+
+;; Copyright © 2015 Alex Kost <address@hidden>
+
+;; 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 c9054e1..8cb4e94 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 560ae6a..6bb8571 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)))))