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) (defun guix-get-param-title (entry-type param)
"Return title of an ENTRY-TYPE entry parameter PARAM." "Return title of an ENTRY-TYPE entry parameter PARAM."
(or (guix-get-key-val guix-param-titles (or (guix-assq-value guix-param-titles
entry-type param) entry-type param)
(prog1 (symbol-name param) (prog1 (symbol-name param)
(message "Couldn't find title for '%S %S'." (message "Couldn't find title for '%S %S'."
entry-type param)))) entry-type param))))
@ -102,15 +102,15 @@ Each element of the list has a form:
(defun guix-get-full-name (entry &optional output) (defun guix-get-full-name (entry &optional output)
"Return name specification of the package ENTRY and OUTPUT." "Return name specification of the package ENTRY and OUTPUT."
(guix-get-name-spec (guix-get-key-val entry 'name) (guix-get-name-spec (guix-assq-value entry 'name)
(guix-get-key-val entry 'version) (guix-assq-value entry 'version)
output)) output))
(defun guix-entry-to-specification (entry) (defun guix-entry-to-specification (entry)
"Return name specification by the package or output ENTRY." "Return name specification by the package or output ENTRY."
(guix-get-name-spec (guix-get-key-val entry 'name) (guix-get-name-spec (guix-assq-value entry 'name)
(guix-get-key-val entry 'version) (guix-assq-value entry 'version)
(guix-get-key-val entry 'output))) (guix-assq-value entry 'output)))
(defun guix-entries-to-specifications (entries) (defun guix-entries-to-specifications (entries)
"Return name specifications by the package or output 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) (defun guix-get-installed-outputs (entry)
"Return list of installed outputs for the package ENTRY." "Return list of installed outputs for the package ENTRY."
(mapcar (lambda (installed-entry) (mapcar (lambda (installed-entry)
(guix-get-key-val installed-entry 'output)) (guix-assq-value installed-entry 'output))
(guix-get-key-val entry 'installed))) (guix-assq-value entry 'installed)))
(defun guix-get-entry-by-id (id entries) (defun guix-get-entry-by-id (id entries)
"Return entry from ENTRIES by entry ID." "Return entry from ENTRIES by entry ID."
(cl-find-if (lambda (entry) (cl-find-if (lambda (entry)
(equal id (guix-get-key-val entry 'id))) (equal id (guix-assq-value entry 'id)))
entries)) entries))
(defun guix-get-package-id-and-output-by-output-id (oid) (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)) (outputs (cdr spec))
(entry (guix-get-entry-by-id id entries))) (entry (guix-get-entry-by-id id entries)))
(when entry (when entry
(let ((location (guix-get-key-val entry 'location))) (let ((location (guix-assq-value entry 'location)))
(concat (guix-get-full-name entry) (concat (guix-get-full-name entry)
(when outputs (when outputs
(concat ":" (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) (defun guix-info-get-insert-methods (entry-type param)
"Return list of insert methods for parameter PARAM of ENTRY-TYPE. "Return list of insert methods for parameter PARAM of ENTRY-TYPE.
See `guix-info-insert-methods' for details." See `guix-info-insert-methods' for details."
(guix-get-key-val guix-info-insert-methods (guix-assq-value guix-info-insert-methods
entry-type param)) entry-type param))
(defun guix-info-get-displayed-params (entry-type) (defun guix-info-get-displayed-params (entry-type)
"Return parameters of ENTRY-TYPE that should be displayed." "Return parameters of ENTRY-TYPE that should be displayed."
(guix-get-key-val guix-info-displayed-params (guix-assq-value guix-info-displayed-params
entry-type)) entry-type))
(defun guix-info-get-indent (&optional level) (defun guix-info-get-indent (&optional level)
"Return `guix-info-indent' \"multiplied\" by LEVEL spaces. "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. "Insert title and value of a PARAM at point.
ENTRY is alist with parameters and their values. ENTRY is alist with parameters and their values.
ENTRY-TYPE is a type of ENTRY." 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)) (unless (and guix-info-ignore-empty-vals (null val))
(let* ((title (guix-get-param-title entry-type param)) (let* ((title (guix-get-param-title entry-type param))
(insert-methods (guix-info-get-insert-methods 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) (defun guix-package-info-insert-heading (entry)
"Insert the heading for package ENTRY. "Insert the heading for package ENTRY.
Show package name, version, and `guix-package-info-heading-params'." Show package name, version, and `guix-package-info-heading-params'."
(guix-format-insert (concat (guix-get-key-val entry 'name) " " (guix-format-insert (concat (guix-assq-value entry 'name) " "
(guix-get-key-val entry 'version)) (guix-assq-value entry 'version))
'guix-package-info-heading) 'guix-package-info-heading)
(insert "\n\n") (insert "\n\n")
(mapc (lambda (param) (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) (face (guix-get-symbol (symbol-name param)
'info 'package))) 'info 'package)))
(when val (when val
@ -587,10 +587,10 @@ If nil, insert installed info in a default way.")
(defun guix-package-info-insert-outputs (outputs entry) (defun guix-package-info-insert-outputs (outputs entry)
"Insert OUTPUTS from package ENTRY at point." "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)) (guix-package-info-insert-obsolete-text))
(and (guix-get-key-val entry 'non-unique) (and (guix-assq-value entry 'non-unique)
(guix-get-key-val entry 'installed) (guix-assq-value entry 'installed)
(guix-package-info-insert-non-unique-text (guix-package-info-insert-non-unique-text
(guix-get-full-name entry))) (guix-get-full-name entry)))
(insert "\n") (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 Make some fancy text with buttons and additional stuff if the
current OUTPUT is installed (if there is such output in current OUTPUT is installed (if there is such output in
`installed' parameter of a package ENTRY)." `installed' parameter of a package ENTRY)."
(let* ((installed (guix-get-key-val entry 'installed)) (let* ((installed (guix-assq-value entry 'installed))
(obsolete (guix-get-key-val entry 'obsolete)) (obsolete (guix-assq-value entry 'obsolete))
(installed-entry (cl-find-if (installed-entry (cl-find-if
(lambda (entry) (lambda (entry)
(string= (guix-get-key-val entry 'output) (string= (guix-assq-value entry 'output)
output)) output))
installed)) installed))
(action-type (if installed-entry 'delete 'install))) (action-type (if installed-entry 'delete 'install)))
@ -655,8 +655,8 @@ ENTRY is an alist with package info."
(current-buffer))) (current-buffer)))
(concat type-str " '" full-name "'") (concat type-str " '" full-name "'")
'action-type type 'action-type type
'id (or (guix-get-key-val entry 'package-id) 'id (or (guix-assq-value entry 'package-id)
(guix-get-key-val entry 'id)) (guix-assq-value entry 'id))
'output output))) 'output output)))
(defun guix-package-info-insert-output-path (path &optional _) (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 (entries (cl-substitute-if
new-entry new-entry
(lambda (entry) (lambda (entry)
(equal (guix-get-key-val entry 'id) (equal (guix-assq-value entry 'id)
entry-id)) entry-id))
guix-entries guix-entries
:count 1))) :count 1)))
@ -746,9 +746,9 @@ SOURCE is a list of URLs."
(guix-info-insert-indent) (guix-info-insert-indent)
(if (null source) (if (null source)
(guix-format-insert nil) (guix-format-insert nil)
(let* ((source-file (guix-get-key-val entry 'source-file)) (let* ((source-file (guix-assq-value entry 'source-file))
(entry-id (guix-get-key-val entry 'id)) (entry-id (guix-assq-value entry 'id))
(package-id (or (guix-get-key-val entry 'package-id) (package-id (or (guix-assq-value entry 'package-id)
entry-id))) entry-id)))
(if (null source-file) (if (null source-file)
(guix-info-insert-action-button (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." "Insert output VERSION and obsolete text if needed at point."
(guix-info-insert-val-default version (guix-info-insert-val-default version
'guix-package-info-version) 'guix-package-info-version)
(and (guix-get-key-val entry 'obsolete) (and (guix-assq-value entry 'obsolete)
(guix-package-info-insert-obsolete-text))) (guix-package-info-insert-obsolete-text)))
(defun guix-output-info-insert-output (output entry) (defun guix-output-info-insert-output (output entry)
"Insert OUTPUT and action buttons at point." "Insert OUTPUT and action buttons at point."
(let* ((installed (guix-get-key-val entry 'installed)) (let* ((installed (guix-assq-value entry 'installed))
(obsolete (guix-get-key-val entry 'obsolete)) (obsolete (guix-assq-value entry 'obsolete))
(action-type (if installed 'delete 'install))) (action-type (if installed 'delete 'install)))
(guix-info-insert-val-default (guix-info-insert-val-default
output output
@ -874,7 +874,7 @@ If nil, insert generation in a default way.")
(guix-switch-to-generation guix-profile (button-get btn 'number) (guix-switch-to-generation guix-profile (button-get btn 'number)
(current-buffer))) (current-buffer)))
"Switch to this generation (make it the current one)" "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) (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 -*- ;;; 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. ;; This file is part of GNU Guix.
@ -110,13 +110,13 @@ parameters and their values).")
(defun guix-list-get-param-title (entry-type param) (defun guix-list-get-param-title (entry-type param)
"Return title of an ENTRY-TYPE entry parameter PARAM." "Return title of an ENTRY-TYPE entry parameter PARAM."
(or (guix-get-key-val guix-list-column-titles (or (guix-assq-value guix-list-column-titles
entry-type param) entry-type param)
(guix-get-param-title entry-type param))) (guix-get-param-title entry-type param)))
(defun guix-list-get-column-format (entry-type) (defun guix-list-get-column-format (entry-type)
"Return column format for 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) (defun guix-list-get-displayed-params (entry-type)
"Return list of parameters of ENTRY-TYPE that should be displayed." "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 Values are taken from ENTRIES which should have the form of
`guix-entries'." `guix-entries'."
(mapcar (lambda (entry) (mapcar (lambda (entry)
(list (guix-get-key-val entry 'id) (list (guix-assq-value entry 'id)
(guix-list-get-tabulated-entry entry entry-type))) (guix-list-get-tabulated-entry entry entry-type)))
entries)) entries))
@ -180,9 +180,9 @@ Parameters are taken from ENTRY of ENTRY-TYPE."
(guix-list-make-tabulated-vector (guix-list-make-tabulated-vector
entry-type entry-type
(lambda (param _) (lambda (param _)
(let ((val (guix-get-key-val entry param)) (let ((val (guix-assq-value entry param))
(fun (guix-get-key-val guix-list-column-value-methods (fun (guix-assq-value guix-list-column-value-methods
entry-type param))) entry-type param)))
(if fun (if fun
(funcall fun val entry) (funcall fun val entry)
(guix-get-string val)))))) (guix-get-string val))))))
@ -221,7 +221,7 @@ VAL may be nil."
(guix-package-list-mode (guix-package-list-mode
(guix-list-current-id)) (guix-list-current-id))
(guix-output-list-mode (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) (defun guix-list-for-each-line (fun &rest args)
"Call FUN with ARGS for each entry line." "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) (defsubst guix-list-get-mark (name)
"Return mark character by its 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))) (error "Mark '%S' not found" name)))
(defsubst guix-list-get-mark-string (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'." "Put marks according to `guix-list-mark-alist'."
(guix-list-for-each-line (guix-list-for-each-line
(lambda () (lambda ()
(let ((mark-name (car (guix-get-key-val guix-list-marked (let ((mark-name (car (guix-assq-value guix-list-marked
(guix-list-current-id))))) (guix-list-current-id)))))
(tabulated-list-put-tag (tabulated-list-put-tag
(guix-list-get-mark-string (or mark-name 'empty))))))) (guix-list-get-mark-string (or mark-name 'empty)))))))
@ -524,16 +524,16 @@ likely)."
Colorize it with `guix-package-list-installed' or Colorize it with `guix-package-list-installed' or
`guix-package-list-obsolete' if needed." `guix-package-list-obsolete' if needed."
(guix-get-string name (guix-get-string name
(cond ((guix-get-key-val entry 'obsolete) (cond ((guix-assq-value entry 'obsolete)
'guix-package-list-obsolete) 'guix-package-list-obsolete)
((guix-get-key-val entry 'installed) ((guix-assq-value entry 'installed)
'guix-package-list-installed)))) 'guix-package-list-installed))))
(defun guix-package-list-get-installed-outputs (installed &optional _) (defun guix-package-list-get-installed-outputs (installed &optional _)
"Return string with outputs from INSTALLED entries." "Return string with outputs from INSTALLED entries."
(guix-get-string (guix-get-string
(mapcar (lambda (entry) (mapcar (lambda (entry)
(guix-get-key-val entry 'output)) (guix-assq-value entry 'output))
installed))) installed)))
(defun guix-package-list-marking-check () (defun guix-package-list-marking-check ()
@ -562,7 +562,7 @@ be separated with \",\")."
(interactive "P") (interactive "P")
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (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)) (installed (guix-get-installed-outputs entry))
(available (cl-set-difference all installed :test #'string=))) (available (cl-set-difference all installed :test #'string=)))
(or available (or available
@ -597,7 +597,7 @@ be separated with \",\")."
(installed (guix-get-installed-outputs entry))) (installed (guix-get-installed-outputs entry)))
(or installed (or installed
(user-error "This package is not 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? ")) (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
(guix-package-list-mark-outputs (guix-package-list-mark-outputs
'upgrade installed 'upgrade installed
@ -611,14 +611,14 @@ accept an entry as argument."
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let ((obsolete (cl-remove-if-not (let ((obsolete (cl-remove-if-not
(lambda (entry) (lambda (entry)
(guix-get-key-val entry 'obsolete)) (guix-assq-value entry 'obsolete))
guix-entries))) guix-entries)))
(guix-list-for-each-line (guix-list-for-each-line
(lambda () (lambda ()
(let* ((id (guix-list-current-id)) (let* ((id (guix-list-current-id))
(entry (cl-find-if (entry (cl-find-if
(lambda (entry) (lambda (entry)
(equal id (guix-get-key-val entry 'id))) (equal id (guix-assq-value entry 'id)))
obsolete))) obsolete)))
(when entry (when entry
(funcall fun entry))))))) (funcall fun entry)))))))
@ -682,7 +682,7 @@ The specification is suitable for `guix-process-package-actions'."
(interactive) (interactive)
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(installed (guix-get-key-val entry 'installed))) (installed (guix-assq-value entry 'installed)))
(if installed (if installed
(user-error "This output is already installed") (user-error "This output is already installed")
(guix-list--mark 'install t)))) (guix-list--mark 'install t))))
@ -692,7 +692,7 @@ The specification is suitable for `guix-process-package-actions'."
(interactive) (interactive)
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(installed (guix-get-key-val entry 'installed))) (installed (guix-assq-value entry 'installed)))
(if installed (if installed
(guix-list--mark 'delete t) (guix-list--mark 'delete t)
(user-error "This output is not installed")))) (user-error "This output is not installed"))))
@ -702,10 +702,10 @@ The specification is suitable for `guix-process-package-actions'."
(interactive) (interactive)
(guix-package-list-marking-check) (guix-package-list-marking-check)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(installed (guix-get-key-val entry 'installed))) (installed (guix-assq-value entry 'installed)))
(or installed (or installed
(user-error "This output is not 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? ")) (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
(guix-list--mark 'upgrade t)))) (guix-list--mark 'upgrade t))))
@ -777,8 +777,8 @@ VAL is a boolean value."
"Switch current profile to the generation at point." "Switch current profile to the generation at point."
(interactive) (interactive)
(let* ((entry (guix-list-current-entry)) (let* ((entry (guix-list-current-entry))
(current (guix-get-key-val entry 'current)) (current (guix-assq-value entry 'current))
(number (guix-get-key-val entry 'number))) (number (guix-assq-value entry 'number)))
(if current (if current
(user-error "This generation is already the current one") (user-error "This generation is already the current one")
(guix-switch-to-generation guix-profile number (current-buffer))))) (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 ;;; 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. ;; This file is part of GNU Guix.
@ -186,14 +186,14 @@
(defun guix-result-message (profile entries entry-type (defun guix-result-message (profile entries entry-type
search-type search-vals) search-type search-vals)
"Display an appropriate message after displaying ENTRIES." "Display an appropriate message after displaying ENTRIES."
(let* ((type-spec (guix-get-key-val guix-messages (let* ((type-spec (guix-assq-value guix-messages
entry-type search-type)) entry-type search-type))
(fun-or-count-spec (car type-spec))) (fun-or-count-spec (car type-spec)))
(if (functionp fun-or-count-spec) (if (functionp fun-or-count-spec)
(funcall fun-or-count-spec profile entries search-vals) (funcall fun-or-count-spec profile entries search-vals)
(let* ((count (length entries)) (let* ((count (length entries))
(count-key (if (> count 1) 'many count)) (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)) (msg (car msg-spec))
(args (cdr msg-spec))) (args (cdr msg-spec)))
(mapc (lambda (subst) (mapc (lambda (subst)

27
emacs/guix-utils.el
View File

@ -193,14 +193,6 @@ Return time value."
(require 'org) (require 'org)
(org-read-date nil t nil prompt)) (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) (defun guix-find-file (file)
"Find FILE if it exists." "Find FILE if it exists."
(if (file-exists-p file) (if (file-exists-p file)
@ -223,6 +215,25 @@ Return nil otherwise."
(or (funcall pred (car lst)) (or (funcall pred (car lst))
(guix-any pred (cdr 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 ;;; Diff