[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"
- 13/20: ui: Add 'run-guix'., (continued)
- 13/20: ui: Add 'run-guix'., Alex Kost, 2015/08/18
- 02/20: emacs: Add 'guix-lint-checker-names'., Alex Kost, 2015/08/18
- 14/20: emacs: Add code to run guix command in REPL., Alex Kost, 2015/08/18
- 10/20: emacs: Add help variables., Alex Kost, 2015/08/18
- 07/20: emacs: Add utils to copy guix command., Alex Kost, 2015/08/18
- 15/20: emacs: Add code to run guix command in shell., Alex Kost, 2015/08/18
- 20/20: emacs: Use popup interface instead 'guix-pull' command., Alex Kost, 2015/08/18
- 11/20: emacs: Add minibuffer readers., Alex Kost, 2015/08/18
- 16/20: doc: Reorganize "Emacs Interface" node., Alex Kost, 2015/08/18
- 17/20: emacs: Add "guix-popup.el"., Alex Kost, 2015/08/18
- 12/20: emacs: Add and use alist accessors.,
Alex Kost <=
- 19/20: emacs: Use prompt for packages instead popup for edit action., Alex Kost, 2015/08/18
- 18/20: emacs: Add popup interface for guix commands., Alex Kost, 2015/08/18