nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Alex Kost 2015-08-16 07:11:57 +03:00
parent d007d8a10c
commit 51dac38339
5 changed files with 83 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
emacs/guix-base.el
View File

@ -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)
@ -934,7 +934,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 ":"

48
emacs/guix-info.el
View File

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

50
emacs/guix-list.el
View File

@ -1,6 +1,6 @@
;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;; 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)))))

8
emacs/guix-messages.el
View File

@ -1,6 +1,6 @@
;;; guix-messages.el --- Minibuffer messages
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;; 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)

27
emacs/guix-utils.el
View File

@ -193,14 +193,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)
@ -223,6 +215,25 @@ Return nil otherwise."
(or (funcall pred (car lst))
(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