emacs: Add 'guix-keyword-args-let'.

* emacs/guix-utils.el (guix-keyword-args-let): New macro.
  (guix-utils-font-lock-keywords): Add it.
* emacs/guix-base.el (guix-define-buffer-type): Use it.
* emacs/guix-list.el (guix-list-define-entry-type): Use it.
* emacs/guix-read.el (guix-define-readers): Use it.

emacs/guix-base.el

@@ -382,21 +382,13 @@ following keywords are available:
          (buf-name-var   (intern (concat prefix "-buffer-name")))
          (revert-var     (intern (concat prefix "-revert-no-confirm")))
          (history-var    (intern (concat prefix "-history-size")))
-         (params-var     (intern (concat prefix "-required-params")))
+         (params-var     (intern (concat prefix "-required-params"))))
-         (buf-name-val   (format "*Guix %s %s*" Entry-type-str Buf-type-str))
+    (guix-keyword-args-let args
-         (revert-val     nil)
+        ((params-val :required '(id))
-         (history-val    20)
+         (history-val :history-size 20)
-         (params-val     '(id)))
+         (revert-val :revert)
-
+         (buf-name-val :buffer-name
-    ;; Process the keyword args.
+                       (format "*Guix %s %s*" Entry-type-str Buf-type-str)))
-    (while (keywordp (car args))
-      (pcase (pop args)
-	(`:required     (setq params-val (pop args)))
-	(`:history-size (setq history-val (pop args)))
-	(`:revert       (setq revert-val (pop args)))
-        (`:buffer-name  (setq buf-name-val (pop args)))
-	(_ (pop args))))
-
       `(progn
          (defgroup ,group nil
            ,(concat Buf-type-str " buffer with " entry-str ".")
@@ -438,7 +430,7 @@ following keywords are available:
                     "\\{" mode-map-str "}")
            (setq-local revert-buffer-function 'guix-revert-buffer)
            (setq-local guix-history-size ,history-var)
-         (and (fboundp ',mode-init-fun) (,mode-init-fun))))))
+           (and (fboundp ',mode-init-fun) (,mode-init-fun)))))))
 
 (put 'guix-define-buffer-type 'lisp-indent-function 'defun)
 

emacs/guix-list.el

@@ -416,19 +416,11 @@ This macro defines the following functions:
          (prefix         (concat "guix-" entry-type-str "-list"))
          (mode-str       (concat prefix "-mode"))
          (init-fun       (intern (concat prefix "-mode-initialize")))
-         (marks-var      (intern (concat prefix "-mark-alist")))
+         (marks-var      (intern (concat prefix "-mark-alist"))))
-         (marks-val      nil)
+    (guix-keyword-args-let args
-         (sort-key       nil)
+        ((sort-key :sort-key)
-         (invert-sort    nil))
+         (invert-sort :invert-sort)
-
+         (marks-val :marks))
-    ;; Process the keyword args.
-    (while (keywordp (car args))
-      (pcase (pop args)
-        (`:sort-key    (setq sort-key (pop args)))
-        (`:invert-sort (setq invert-sort (pop args)))
-	(`:marks       (setq marks-val (pop args)))
-	(_ (pop args))))
-
       `(progn
          (defvar ,marks-var ',marks-val
            ,(concat "Alist of additional marks for `" mode-str "'.\n"
@@ -454,7 +446,7 @@ This macro defines the following functions:
                  (guix-list-tabulated-format ',entry-type))
            (setq-local guix-list-mark-alist
                        (append guix-list-mark-alist ,marks-var))
-         (tabulated-list-init-header)))))
+           (tabulated-list-init-header))))))
 
 (put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
 

emacs/guix-read.el

@@ -66,26 +66,14 @@ keywords are available:
     `<multiple-reader-name>-string' function returning a string
     of multiple values separated the specified separator will be
     defined."
-  (let (completions-var
+  (guix-keyword-args-let args
-        completions-getter
+      ((completions-var    :completions-var)
-        single-reader
+       (completions-getter :completions-getter)
-        single-prompt
+       (single-reader      :single-reader)
-        multiple-reader
+       (single-prompt      :single-prompt)
-        multiple-prompt
+       (multiple-reader    :multiple-reader)
-        multiple-separator)
+       (multiple-prompt    :multiple-prompt)
-
+       (multiple-separator :multiple-separator))
-    ;; Process the keyword args.
-    (while (keywordp (car args))
-      (pcase (pop args)
-        (`:completions-var    (setq completions-var    (pop args)))
-        (`:completions-getter (setq completions-getter (pop args)))
-        (`:single-reader      (setq single-reader      (pop args)))
-        (`:single-prompt      (setq single-prompt      (pop args)))
-        (`:multiple-reader    (setq multiple-reader    (pop args)))
-        (`:multiple-prompt    (setq multiple-prompt    (pop args)))
-        (`:multiple-separator (setq multiple-separator (pop args)))
-	(_ (pop args))))
-
     (let ((completions
            (cond ((and completions-var completions-getter)
                   `(or ,completions-var

emacs/guix-utils.el

@@ -257,6 +257,55 @@ modifier call."
     (guix-modify (funcall (car modifiers) object)
                  (cdr modifiers))))
 
+(defmacro guix-keyword-args-let (args varlist &rest body)
+  "Parse ARGS, bind variables from VARLIST and eval BODY.
+
+Find keyword values in ARGS, bind them to variables according to
+VARLIST, then evaluate BODY.
+
+ARGS is a keyword/value property list.
+
+Each element of VARLIST has a form:
+
+  (SYMBOL KEYWORD [DEFAULT-VALUE])
+
+SYMBOL is a varible name.  KEYWORD is a symbol that will be
+searched in ARGS for an according value.  If the value of KEYWORD
+does not exist, bind SYMBOL to DEFAULT-VALUE or nil.
+
+The rest arguments (that present in ARGS but not in VARLIST) will
+be bound to `%foreign-args' variable.
+
+Example:
+
+  (guix-keyword-args-let '(:two 8 :great ! :guix is)
+      ((one :one 1)
+       (two :two 2)
+       (foo :smth))
+    (list one two foo %foreign-args))
+
+  => (1 8 nil (:guix is :great !))"
+  (declare (indent 2))
+  (let ((args-var (make-symbol "args")))
+    `(let (,@(mapcar (lambda (spec)
+                       (pcase-let ((`(,name ,_ ,val) spec))
+                         (list name val)))
+                     varlist)
+           (,args-var ,args)
+           %foreign-args)
+       (while ,args-var
+         (pcase ,args-var
+           (`(,key ,val . ,rest-args)
+            (cl-case key
+              ,@(mapcar (lambda (spec)
+                          (pcase-let ((`(,name ,key ,_) spec))
+                            `(,key (setq ,name val))))
+                        varlist)
+              (t (setq %foreign-args
+                       (cl-list* key val %foreign-args))))
+            (setq ,args-var rest-args))))
+       ,@body)))
+
 
 ;;; Alist accessors
 
@@ -326,7 +375,8 @@ See `defun' for the meaning of arguments."
 
 (defvar guix-utils-font-lock-keywords
   (eval-when-compile
-    `((,(rx "(" (group "guix-with-indent")
+    `((,(rx "(" (group (or "guix-keyword-args-let"
+                           "guix-with-indent"))
             symbol-end)
        . 1)
       (,(rx "("