guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

12/20: emacs: Add and use alist accessors.


From: Alex Kost
Subject: 12/20: emacs: Add and use alist accessors.
Date: Tue, 18 Aug 2015 09:41:12 +0000

alezost pushed a commit to branch wip-emacs-popup-ui
in repository guix.

commit 0c020793ee54e51cd77344fc2b7b98fe9ebd224a
Author: Alex Kost <address@hidden>
Date:   Sun Aug 16 07:11:57 2015 +0300

    emacs: Add and use alist accessors.
    
    * emacs/guix-utils.el (guix-define-alist-accessor): New macro.
      (guix-assq-value, guix-assoc-value): New functions.
      (guix-get-key-val): Remove.
    * emacs/guix-base.el: Replace 'guix-get-key-val' with 'guix-assq-value'
      everywhere.
    * emacs/guix-info.el: Likewise.
    * emacs/guix-list.el: Likewise.
    * emacs/guix-messages.el: Likewise.
---
 emacs/guix-base.el     |   22 ++++++++++----------
 emacs/guix-info.el     |   48 +++++++++++++++++++++++-----------------------
 emacs/guix-list.el     |   50 ++++++++++++++++++++++++------------------------
 emacs/guix-messages.el |    8 +++---
 emacs/guix-utils.el    |   27 ++++++++++++++++++-------
 5 files changed, 83 insertions(+), 72 deletions(-)

diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index 2a59a5b..f9bf129 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -89,8 +89,8 @@ Each element of the list has a form:
 
 (defun guix-get-param-title (entry-type param)
   "Return title of an ENTRY-TYPE entry parameter PARAM."
-  (or (guix-get-key-val guix-param-titles
-                        entry-type param)
+  (or (guix-assq-value guix-param-titles
+                       entry-type param)
       (prog1 (symbol-name param)
         (message "Couldn't find title for '%S %S'."
                  entry-type param))))
@@ -102,15 +102,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-get-key-val entry 'name)
-                      (guix-get-key-val entry 'version)
+  (guix-get-name-spec (guix-assq-value entry 'name)
+                      (guix-assq-value entry 'version)
                       output))
 
 (defun guix-entry-to-specification (entry)
   "Return name specification by the package or output ENTRY."
-  (guix-get-name-spec (guix-get-key-val entry 'name)
-                      (guix-get-key-val entry 'version)
-                      (guix-get-key-val entry 'output)))
+  (guix-get-name-spec (guix-assq-value entry 'name)
+                      (guix-assq-value entry 'version)
+                      (guix-assq-value entry 'output)))
 
 (defun guix-entries-to-specifications (entries)
   "Return name specifications by the package or output ENTRIES."
@@ -120,13 +120,13 @@ 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-get-key-val installed-entry 'output))
-          (guix-get-key-val entry 'installed)))
+            (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-get-key-val entry 'id)))
+                (equal id (guix-assq-value entry 'id)))
               entries))
 
 (defun guix-get-package-id-and-output-by-output-id (oid)
@@ -943,7 +943,7 @@ ENTRIES is a list of package entries to get info about 
packages."
                   (outputs (cdr spec))
                   (entry (guix-get-entry-by-id id entries)))
              (when entry
-               (let ((location (guix-get-key-val entry 'location)))
+               (let ((location (guix-assq-value entry 'location)))
                  (concat (guix-get-full-name entry)
                          (when outputs
                            (concat ":"
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index f17ce01..4bdd62a 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -178,13 +178,13 @@ The order of displayed parameters is the same as in this 
list.")
 (defun guix-info-get-insert-methods (entry-type param)
   "Return list of insert methods for parameter PARAM of ENTRY-TYPE.
 See `guix-info-insert-methods' for details."
-  (guix-get-key-val guix-info-insert-methods
-                    entry-type param))
+  (guix-assq-value guix-info-insert-methods
+                   entry-type param))
 
 (defun guix-info-get-displayed-params (entry-type)
   "Return parameters of ENTRY-TYPE that should be displayed."
-  (guix-get-key-val guix-info-displayed-params
-                    entry-type))
+  (guix-assq-value guix-info-displayed-params
+                   entry-type))
 
 (defun guix-info-get-indent (&optional level)
   "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
@@ -232,7 +232,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-get-key-val entry param)))
+  (let ((val (guix-assq-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))
@@ -492,12 +492,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-get-key-val entry 'name) " "
-                              (guix-get-key-val entry 'version))
+  (guix-format-insert (concat (guix-assq-value entry 'name) " "
+                              (guix-assq-value entry 'version))
                       'guix-package-info-heading)
   (insert "\n\n")
   (mapc (lambda (param)
-          (let ((val  (guix-get-key-val entry param))
+          (let ((val  (guix-assq-value entry param))
                 (face (guix-get-symbol (symbol-name param)
                                        'info 'package)))
             (when val
@@ -587,10 +587,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-get-key-val entry 'obsolete)
+  (and (guix-assq-value entry 'obsolete)
        (guix-package-info-insert-obsolete-text))
-  (and (guix-get-key-val entry 'non-unique)
-       (guix-get-key-val entry 'installed)
+  (and (guix-assq-value entry 'non-unique)
+       (guix-assq-value entry 'installed)
        (guix-package-info-insert-non-unique-text
         (guix-get-full-name entry)))
   (insert "\n")
@@ -617,11 +617,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-get-key-val entry 'installed))
-         (obsolete  (guix-get-key-val entry 'obsolete))
+  (let* ((installed (guix-assq-value entry 'installed))
+         (obsolete  (guix-assq-value entry 'obsolete))
          (installed-entry (cl-find-if
                            (lambda (entry)
-                             (string= (guix-get-key-val entry 'output)
+                             (string= (guix-assq-value entry 'output)
                                       output))
                            installed))
          (action-type (if installed-entry 'delete 'install)))
@@ -655,8 +655,8 @@ ENTRY is an alist with package info."
         (current-buffer)))
      (concat type-str " '" full-name "'")
      'action-type type
-     'id (or (guix-get-key-val entry 'package-id)
-             (guix-get-key-val entry 'id))
+     'id (or (guix-assq-value entry 'package-id)
+             (guix-assq-value entry 'id))
      'output output)))
 
 (defun guix-package-info-insert-output-path (path &optional _)
@@ -720,7 +720,7 @@ PACKAGE-ID is an ID of the package which source to show."
            (entries (cl-substitute-if
                      new-entry
                      (lambda (entry)
-                       (equal (guix-get-key-val entry 'id)
+                       (equal (guix-assq-value entry 'id)
                               entry-id))
                      guix-entries
                      :count 1)))
@@ -746,9 +746,9 @@ SOURCE is a list of URLs."
   (guix-info-insert-indent)
   (if (null source)
       (guix-format-insert nil)
-    (let* ((source-file (guix-get-key-val entry 'source-file))
-           (entry-id    (guix-get-key-val entry 'id))
-           (package-id  (or (guix-get-key-val entry 'package-id)
+    (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)
                             entry-id)))
       (if (null source-file)
           (guix-info-insert-action-button
@@ -798,13 +798,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-get-key-val entry 'obsolete)
+  (and (guix-assq-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-get-key-val entry 'installed))
-         (obsolete  (guix-get-key-val entry 'obsolete))
+  (let* ((installed (guix-assq-value entry 'installed))
+         (obsolete  (guix-assq-value entry 'obsolete))
          (action-type (if installed 'delete 'install)))
     (guix-info-insert-val-default
      output
@@ -874,7 +874,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-get-key-val entry 'number))))
+     'number (guix-assq-value entry 'number))))
 
 (provide 'guix-info)
 
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index e84d60a..abb0232 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -1,6 +1,6 @@
 ;;; guix-list.el --- List buffers for displaying entries   -*- 
lexical-binding: t -*-
 
-;; Copyright © 2014 Alex Kost <address@hidden>
+;; Copyright © 2014, 2015 Alex Kost <address@hidden>
 
 ;; This file is part of GNU Guix.
 
@@ -110,13 +110,13 @@ parameters and their values).")
 
 (defun guix-list-get-param-title (entry-type param)
   "Return title of an ENTRY-TYPE entry parameter PARAM."
-  (or (guix-get-key-val guix-list-column-titles
-                        entry-type param)
+  (or (guix-assq-value guix-list-column-titles
+                       entry-type param)
       (guix-get-param-title entry-type param)))
 
 (defun guix-list-get-column-format (entry-type)
   "Return column format for ENTRY-TYPE."
-  (guix-get-key-val guix-list-column-format entry-type))
+  (guix-assq-value guix-list-column-format entry-type))
 
 (defun guix-list-get-displayed-params (entry-type)
   "Return list of parameters of ENTRY-TYPE that should be displayed."
@@ -170,7 +170,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-get-key-val entry 'id)
+            (list (guix-assq-value entry 'id)
                   (guix-list-get-tabulated-entry entry entry-type)))
           entries))
 
@@ -180,9 +180,9 @@ Parameters are taken from ENTRY of ENTRY-TYPE."
   (guix-list-make-tabulated-vector
    entry-type
    (lambda (param _)
-     (let ((val (guix-get-key-val entry param))
-           (fun (guix-get-key-val guix-list-column-value-methods
-                                  entry-type param)))
+     (let ((val (guix-assq-value entry param))
+           (fun (guix-assq-value guix-list-column-value-methods
+                                 entry-type param)))
        (if fun
            (funcall fun val entry)
          (guix-get-string val))))))
@@ -221,7 +221,7 @@ VAL may be nil."
     (guix-package-list-mode
      (guix-list-current-id))
     (guix-output-list-mode
-     (guix-get-key-val (guix-list-current-entry) 'package-id))))
+     (guix-assq-value (guix-list-current-entry) 'package-id))))
 
 (defun guix-list-for-each-line (fun &rest args)
   "Call FUN with ARGS for each entry line."
@@ -262,7 +262,7 @@ ARGS is a list of additional values.")
 
 (defsubst guix-list-get-mark (name)
   "Return mark character by its NAME."
-  (or (guix-get-key-val guix-list-mark-alist name)
+  (or (guix-assq-value guix-list-mark-alist name)
       (error "Mark '%S' not found" name)))
 
 (defsubst guix-list-get-mark-string (name)
@@ -355,8 +355,8 @@ With ARG, unmark all lines."
   "Put marks according to `guix-list-mark-alist'."
   (guix-list-for-each-line
    (lambda ()
-     (let ((mark-name (car (guix-get-key-val guix-list-marked
-                                             (guix-list-current-id)))))
+     (let ((mark-name (car (guix-assq-value guix-list-marked
+                                            (guix-list-current-id)))))
        (tabulated-list-put-tag
         (guix-list-get-mark-string (or mark-name 'empty)))))))
 
@@ -524,16 +524,16 @@ likely)."
 Colorize it with `guix-package-list-installed' or
 `guix-package-list-obsolete' if needed."
   (guix-get-string name
-                   (cond ((guix-get-key-val entry 'obsolete)
+                   (cond ((guix-assq-value entry 'obsolete)
                           'guix-package-list-obsolete)
-                         ((guix-get-key-val entry 'installed)
+                         ((guix-assq-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-get-key-val entry 'output))
+             (guix-assq-value entry 'output))
            installed)))
 
 (defun guix-package-list-marking-check ()
@@ -562,7 +562,7 @@ be separated with \",\")."
   (interactive "P")
   (guix-package-list-marking-check)
   (let* ((entry     (guix-list-current-entry))
-         (all       (guix-get-key-val entry 'outputs))
+         (all       (guix-assq-value entry 'outputs))
          (installed (guix-get-installed-outputs entry))
          (available (cl-set-difference all installed :test #'string=)))
     (or available
@@ -597,7 +597,7 @@ be separated with \",\")."
          (installed (guix-get-installed-outputs entry)))
     (or installed
         (user-error "This package is not installed"))
-    (when (or (guix-get-key-val entry 'obsolete)
+    (when (or (guix-assq-value entry 'obsolete)
               (y-or-n-p "This package is not obsolete.  Try to upgrade it 
anyway? "))
       (guix-package-list-mark-outputs
        'upgrade installed
@@ -611,14 +611,14 @@ accept an entry as argument."
   (guix-package-list-marking-check)
   (let ((obsolete (cl-remove-if-not
                    (lambda (entry)
-                     (guix-get-key-val entry 'obsolete))
+                     (guix-assq-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-get-key-val entry 'id)))
+                        (equal id (guix-assq-value entry 'id)))
                       obsolete)))
          (when entry
            (funcall fun entry)))))))
@@ -682,7 +682,7 @@ The specification is suitable for 
`guix-process-package-actions'."
   (interactive)
   (guix-package-list-marking-check)
   (let* ((entry     (guix-list-current-entry))
-         (installed (guix-get-key-val entry 'installed)))
+         (installed (guix-assq-value entry 'installed)))
     (if installed
         (user-error "This output is already installed")
       (guix-list--mark 'install t))))
@@ -692,7 +692,7 @@ The specification is suitable for 
`guix-process-package-actions'."
   (interactive)
   (guix-package-list-marking-check)
   (let* ((entry     (guix-list-current-entry))
-         (installed (guix-get-key-val entry 'installed)))
+         (installed (guix-assq-value entry 'installed)))
     (if installed
         (guix-list--mark 'delete t)
       (user-error "This output is not installed"))))
@@ -702,10 +702,10 @@ The specification is suitable for 
`guix-process-package-actions'."
   (interactive)
   (guix-package-list-marking-check)
   (let* ((entry     (guix-list-current-entry))
-         (installed (guix-get-key-val entry 'installed)))
+         (installed (guix-assq-value entry 'installed)))
     (or installed
         (user-error "This output is not installed"))
-    (when (or (guix-get-key-val entry 'obsolete)
+    (when (or (guix-assq-value entry 'obsolete)
               (y-or-n-p "This output is not obsolete.  Try to upgrade it 
anyway? "))
       (guix-list--mark 'upgrade t))))
 
@@ -777,8 +777,8 @@ VAL is a boolean value."
   "Switch current profile to the generation at point."
   (interactive)
   (let* ((entry   (guix-list-current-entry))
-         (current (guix-get-key-val entry 'current))
-         (number  (guix-get-key-val entry 'number)))
+         (current (guix-assq-value entry 'current))
+         (number  (guix-assq-value entry 'number)))
     (if current
         (user-error "This generation is already the current one")
       (guix-switch-to-generation guix-profile number (current-buffer)))))
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
index bd985a0..2bf99de 100644
--- a/emacs/guix-messages.el
+++ b/emacs/guix-messages.el
@@ -1,6 +1,6 @@
 ;;; guix-messages.el --- Minibuffer messages
 
-;; Copyright © 2014 Alex Kost <address@hidden>
+;; Copyright © 2014, 2015 Alex Kost <address@hidden>
 
 ;; This file is part of GNU Guix.
 
@@ -186,14 +186,14 @@
 (defun guix-result-message (profile entries entry-type
                             search-type search-vals)
   "Display an appropriate message after displaying ENTRIES."
-  (let* ((type-spec (guix-get-key-val guix-messages
-                                      entry-type search-type))
+  (let* ((type-spec (guix-assq-value guix-messages
+                                     entry-type search-type))
          (fun-or-count-spec (car type-spec)))
     (if (functionp fun-or-count-spec)
         (funcall fun-or-count-spec profile entries search-vals)
       (let* ((count     (length entries))
              (count-key (if (> count 1) 'many count))
-             (msg-spec  (guix-get-key-val type-spec count-key))
+             (msg-spec  (guix-assq-value type-spec count-key))
              (msg       (car msg-spec))
              (args      (cdr msg-spec)))
         (mapc (lambda (subst)
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
index 8f7405e..ff1c9de 100644
--- a/emacs/guix-utils.el
+++ b/emacs/guix-utils.el
@@ -182,14 +182,6 @@ Return time value."
   (require 'org)
   (org-read-date nil t nil prompt))
 
-(defun guix-get-key-val (alist &rest keys)
-  "Return value from ALIST by KEYS.
-ALIST is alist of alists of alists ... which can be consecutively
-accessed with KEYS."
-  (let ((val alist))
-    (dolist (key keys val)
-      (setq val (cdr (assq key val))))))
-
 (defun guix-find-file (file)
   "Find FILE if it exists."
   (if (file-exists-p file)
@@ -213,6 +205,25 @@ Return nil otherwise."
         (guix-any pred (cdr lst)))))
 
 
+;;; Alist accessors
+
+(defmacro guix-define-alist-accessor (name assoc-fun)
+  "Define NAME function to access alist values using ASSOC-FUN."
+  `(defun ,name (alist &rest keys)
+     ,(format "Return value from ALIST by KEYS using `%s'.
+ALIST is alist of alists of alists ... which can be consecutively
+accessed with KEYS."
+              assoc-fun)
+     (if (or (null alist) (null keys))
+         alist
+       (apply #',name
+              (cdr (,assoc-fun (car keys) alist))
+              (cdr keys)))))
+
+(guix-define-alist-accessor guix-assq-value assq)
+(guix-define-alist-accessor guix-assoc-value assoc)
+
+
 ;;; Diff
 
 (defvar guix-diff-switches "-u"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]