12/12: emacs: Add popup interface for guix commands.

[Alex Kost]

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

commit 220f64deb7d4d8f26131b47105efa1c60eb7126d
Author: Alex Kost <address@hidden>
Date:   Fri Aug 14 10:47:10 2015 +0300

    emacs: Add popup interface for guix commands.
    
    * emacs/guix-command.el: New file.
    * emacs.am (ELFILES): Add it.
    * emacs/guix-utils.el (guix-command-symbol, guix-command-string): New
      functions.
    * doc/emacs.texi (Emacs Initial Setup): Mention 'magit-popup' library.
      (Emacs Popup Interface): New node.
      (Emacs Interface): Add it.
    * doc/guix.texi (Top): Likewise.
---
 doc/emacs.texi        |   21 ++
 doc/guix.texi         |    1 +
 emacs.am              |    1 +
 emacs/guix-command.el |  598 +++++++++++++++++++++++++++++++++++++++++++++++++
 emacs/guix-utils.el   |    8 +
 5 files changed, 629 insertions(+), 0 deletions(-)

diff --git a/doc/emacs.texi b/doc/emacs.texi
index 37a269e..35519cd 100644
--- a/doc/emacs.texi
+++ b/doc/emacs.texi
@@ -9,6 +9,7 @@ Guix convenient and fun.
 @menu
 * Initial Setup: Emacs Initial Setup.  Preparing @file{~/.emacs}.
 * Package Management: Emacs Package Management.        Managing packages and 
generations.
+* Popup Interface: Emacs Popup Interface.      Magit-like interface for guix 
commands.
 * Prettify Mode: Emacs Prettify.       Abbreviating @file{/gnu/store/@dots{}} 
file names.
 * Completions: Emacs Completions.       Completing @command{guix} shell 
command.
 @end menu
@@ -34,6 +35,10 @@ later;
 @uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
 used for interacting with the Guile process.
 
address@hidden
address@hidden://github.com/magit/magit/, magit-popup library}.  You already
+have this library if you use magit 2.1.0 or later.
+
 @end itemize
 
 When it is done ``guix.el'' may be configured by requiring a special
@@ -484,6 +489,22 @@ Various settings for ``info'' buffers.
 @end table
 
 
address@hidden Emacs Popup Interface
address@hidden Popup Interface
+
+If you ever used Magit, you know what ``popup interface'' is
+(@pxref{Top,,, magit-popup, Magit-Popup User Manual}).  Even if you are
+not acquainted with Magit, there should be no worries as it is very
+intuitive.
+
+So @address@hidden command provides a top-level popup interface to
+all available guix commands.  After you specify all options and switches
+for the command you want, it will be executed in the Guix REPL (and it
+will be faster than running @address@hidden@dots{}} command directly in
+shell, as there will be no need to run guile process and to load
+required modules there).
+
+
 @node Emacs Prettify
 @section Guix Prettify Mode
 
diff --git a/doc/guix.texi b/doc/guix.texi
index 64766e1..31525e3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -112,6 +112,7 @@ Emacs Interface
 
 * Initial Setup: Emacs Initial Setup.  Preparing @file{~/.emacs}.
 * Package Management: Emacs Package Management.        Managing packages and 
generations.
+* Popup Interface: Emacs Popup Interface.      Magit-like interface for guix 
commands.
 * Prettify Mode: Emacs Prettify.       Abbreviating @file{/gnu/store/@dots{}} 
file names.
 * Completions: Emacs Completions.       Completing @command{guix} shell 
command.
 
diff --git a/emacs.am b/emacs.am
index e3f2001..bf91cca 100644
--- a/emacs.am
+++ b/emacs.am
@@ -21,6 +21,7 @@ AUTOLOADS = emacs/guix-autoloads.el
 ELFILES =                                      \
   emacs/guix-backend.el                                \
   emacs/guix-base.el                           \
+  emacs/guix-command.el                                \
   emacs/guix-emacs.el                          \
   emacs/guix-help-vars.el                      \
   emacs/guix-history.el                                \
diff --git a/emacs/guix-command.el b/emacs/guix-command.el
new file mode 100644
index 0000000..6a8dcde
--- /dev/null
+++ b/emacs/guix-command.el
@@ -0,0 +1,598 @@
+;;; guix-command.el --- Popup interface for guix commands  -*- 
lexical-binding: t -*-
+
+;; Copyright © 2015 Alex Kost <address@hidden>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a magit-like popup interface for running guix
+;; commands in Guix REPL.  The entry point is "M-x guix".  When it is
+;; called the first time, "guix --help" output is parsed and
+;; `guix-COMMAND-action' functions are generated for each available guix
+;; COMMAND.  Then a window with these commands is popped up.  When a
+;; particular COMMAND is called, "guix COMMAND --help" output is parsed,
+;; and a user get a new popup window with available options for this
+;; command and so on.
+
+;; To avoid hard-coding all guix options, actions, etc., as much data is
+;; taken from "guix ... --help" outputs as possible.  But this data is
+;; still incomplete: not all long options have short analogs, also for
+;; some options special readers should be used (for example, to complete
+;; package names while prompting for a package).  So after parsing --help
+;; output, the arguments (all switches, options and actions are
+;; `guix-command-argument' structures) should be "improved":
+;; `guix-command-arguments' is the root function used to parse arguments,
+;; improve them and add more arguments if needed.
+
+;; So only "M-x guix" command is available after this file is loaded.
+;; The rest commands/actions/popups are generated on the fly only when
+;; they are needed (that's why there is a couple of `eval'-s in this
+;; file).
+
+;; COMMANDS argument is used by many functions in this file.  It means a
+;; list of guix commands without "guix" itself, e.g.: ("build"),
+;; ("import" "gnu").  The empty list stands for plain "guix" without
+;; subcommands.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'guix-popup)
+(require 'guix-utils)
+(require 'guix-help-vars)
+(require 'guix-read)
+(require 'guix-base)
+
+(defvar guix-command-complex-commands '(() ("import"))
+  "List of guix commands which have subcommands with separate options.
+This list is used to define when a command needs additional popup
+windows for its subcommands.")
+
+(defun guix-command-complex-p (commands)
+  "Return non-nil, if 'guix COMMANDS ...' has subcommands."
+  (member commands guix-command-complex-commands))
+
+
+;;; Command arguments
+
+(cl-defstruct (guix-command-argument
+               (:constructor guix-command-make-argument)
+               (:copier      guix-command-copy-argument))
+  name char doc fun switch? option? action?)
+
+(cl-defun guix-command-modify-argument
+    (argument &key
+              (name    nil name-bound?)
+              (char    nil char-bound?)
+              (doc     nil doc-bound?)
+              (fun     nil fun-bound?)
+              (switch? nil switch?-bound?)
+              (option? nil option?-bound?)
+              (action? nil action?-bound?))
+  "Return a modified version of ARGUMENT."
+  (declare (indent 1))
+  (let ((copy (guix-command-copy-argument argument)))
+    (and name-bound?    (setf (guix-command-argument-name    copy) name))
+    (and char-bound?    (setf (guix-command-argument-char    copy) char))
+    (and doc-bound?     (setf (guix-command-argument-doc     copy) doc))
+    (and fun-bound?     (setf (guix-command-argument-fun     copy) fun))
+    (and switch?-bound? (setf (guix-command-argument-switch? copy) switch?))
+    (and option?-bound? (setf (guix-command-argument-option? copy) option?))
+    (and action?-bound? (setf (guix-command-argument-action? copy) action?))
+    copy))
+
+(defun guix-command-modify-argument-from-alist (argument alist)
+  "Return a modified version of ARGUMENT or nil if it wasn't modified.
+Each assoc from ALIST have a form (NAME . PLIST).  NAME is an
+argument name.  PLIST is a property list of argument parameters
+to be modified."
+  (let* ((name  (guix-command-argument-name argument))
+         (plist (cdr (assoc name alist))))
+    (when plist
+      (apply #'guix-command-modify-argument
+             argument plist))))
+
+(defmacro guix-command-define-argument-improver (name alist)
+  "Define NAME variable and function to modify an argument from ALIST."
+  (declare (indent 1))
+  `(progn
+     (defvar ,name ,alist)
+     (defun ,name (argument)
+       (guix-command-modify-argument-from-alist argument ,name))))
+
+(guix-command-define-argument-improver
+    guix-command-improve-action-argument
+  '(("environment" :char ?E)
+    ("publish"     :char ?u)
+    ("pull"        :char ?P)
+    ("size"        :char ?z)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-common-argument
+  '(("--help"    :switch? nil)
+    ("--version" :switch? nil)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-target-argument
+  '(("--target" :char ?T)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-system-type-argument
+  '(("--system" :fun guix-read-system-type)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-load-path-argument
+  '(("--load-path" :fun read-directory-name)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-search-paths-argument
+  '(("--search-paths" :char ?P)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-substitute-urls-argument
+  '(("--substitute-urls" :char ?U)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-hash-argument
+  '(("--format" :fun guix-read-hash-format)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-key-policy-argument
+  '(("--key-download" :fun guix-read-key-policy)))
+
+(defvar guix-command-improve-common-build-argument
+  '(("--fallback"        :char ?F)
+    ("--no-substitutes"  :char ?s)
+    ("--no-build-hook"   :char ?h)
+    ("--max-silent-time" :char ?x)))
+
+(defun guix-command-improve-common-build-argument (argument)
+  (guix-command-modify-argument-from-alist
+   argument
+   (append guix-command-improve-load-path-argument
+           guix-command-improve-substitute-urls-argument
+           guix-command-improve-common-build-argument)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-archive-argument
+  '(("--generate-key" :char ?k)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-build-argument
+  '(("--no-grafts"   :char ?g)
+    ("--root"        :fun guix-read-file-name)
+    ("--sources"     :char ?S :fun guix-read-source-type :switch? nil)
+    ("--with-source" :fun guix-read-file-name)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-environment-argument
+  '(("--load" :fun guix-read-file-name)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-gc-argument
+  '(("--list-dead" :char ?D)
+    ("--list-live" :char ?L)
+    ("--referrers" :char ?f)
+    ("--verify"    :fun guix-read-verify-options-string)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-import-elpa-argument
+  '(("--archive" :fun guix-read-elpa-archive)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-lint-argument
+  '(("--checkers" :fun guix-read-lint-checker-names-string)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-package-argument
+  ;; Unlike all other options, --install/--remove do not have a form
+  ;; '--install=foo,bar' but '--install foo bar' instead, so we need
+  ;; some tweaks.
+  '(("--install"
+     :name "--install " :fun guix-read-package-names-string
+     :switch? nil :option? t)
+    ("--remove"
+     :name "--remove " :fun guix-read-package-names-string
+     :switch? nil :option? t)
+    ("--do-not-upgrade" :char ?U)
+    ("--manifest"       :fun guix-read-file-name)
+    ("--roll-back"      :char ?R)
+    ("--show"           :char ?w :fun guix-read-package-name)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-refresh-argument
+  '(("--select"     :fun guix-read-refresh-subset)
+    ("--key-server" :char ?S)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-size-argument
+  '(("--map-file" :fun guix-read-file-name)))
+
+(guix-command-define-argument-improver
+    guix-command-improve-system-argument
+  '(("vm-image"    :char ?V)
+    ("--on-error"  :char ?E)
+    ("--no-grub"   :char ?g)
+    ("--full-boot" :char ?b)))
+
+(defvar guix-command-improvers
+  '((()
+     guix-command-improve-action-argument)
+    (("archive")
+     guix-command-improve-common-build-argument
+     guix-command-improve-target-argument
+     guix-command-improve-system-type-argument
+     guix-command-improve-archive-argument)
+    (("build")
+     guix-command-improve-common-build-argument
+     guix-command-improve-target-argument
+     guix-command-improve-system-type-argument
+     guix-command-improve-build-argument)
+    (("download")
+     guix-command-improve-hash-argument)
+    (("hash")
+     guix-command-improve-hash-argument)
+    (("environment")
+     guix-command-improve-common-build-argument
+     guix-command-improve-search-paths-argument
+     guix-command-improve-system-type-argument
+     guix-command-improve-environment-argument)
+    (("gc")
+     guix-command-improve-gc-argument)
+    (("import" "gnu")
+     guix-command-improve-key-policy-argument)
+    (("import" "elpa")
+     guix-command-improve-import-elpa-argument)
+    (("lint")
+     guix-command-improve-lint-argument)
+    (("package")
+     guix-command-improve-common-build-argument
+     guix-command-improve-search-paths-argument
+     guix-command-improve-package-argument)
+    (("refresh")
+     guix-command-improve-key-policy-argument
+     guix-command-improve-refresh-argument)
+    (("size")
+     guix-command-improve-system-type-argument
+     guix-command-improve-substitute-urls-argument
+     guix-command-improve-size-argument)
+    (("system")
+     guix-command-improve-common-build-argument
+     guix-command-improve-system-argument))
+  "Alist of guix commands and argument improvers for them.")
+
+(defun guix-command-argument-improvers (commands)
+  "Return a list of argument improvers for COMMANDS."
+  (cdr (assoc commands guix-command-improvers)))
+
+(defun guix-command-improve-argument (argument improvers)
+  "Return ARGUMENT modified with IMPROVERS."
+  (or (guix-any (lambda (improver)
+                  (funcall improver argument))
+                improvers)
+      argument))
+
+(defun guix-command-improve-arguments (arguments commands)
+  "Return ARGUMENTS for 'guix COMMANDS ...' modified for popup interface."
+  (let ((improvers (cons 'guix-command-improve-common-argument
+                         (guix-command-argument-improvers commands))))
+    (mapcar (lambda (argument)
+              (guix-command-improve-argument argument improvers))
+            arguments)))
+
+(defun guix-command-parse-arguments (&optional commands)
+  "Return a list of parsed 'guix COMMANDS ...' arguments."
+  (with-temp-buffer
+    (insert (guix-help-string commands))
+    (let (args)
+      (guix-while-search guix-help-parse-option-regexp
+        (let* ((short (match-string-no-properties 1))
+               (name  (match-string-no-properties 2))
+               (arg   (match-string-no-properties 3))
+               (doc   (match-string-no-properties 4))
+               (char  (if short
+                          (elt short 1) ; short option letter
+                        (elt name 2))) ; first letter of the long option
+               ;; If "--foo=bar" or "--foo[=bar]" then it is 'option'.
+               (option? (not (string= "" arg)))
+               ;; If "--foo" or "--foo[=bar]" then it is 'switch'.
+               (switch? (or (string= "" arg)
+                            (eq ?\[ (elt arg 0)))))
+          (push (guix-command-make-argument
+                 :name    name
+                 :char    char
+                 :doc     doc
+                 :switch? switch?
+                 :option? option?)
+                args)))
+      (guix-while-search guix-help-parse-command-regexp
+        (let* ((name (match-string-no-properties 1))
+               (char (elt name 0)))
+          (push (guix-command-make-argument
+                 :name    name
+                 :char    char
+                 :fun     (guix-command-symbol `(,@commands ,name "action"))
+                 :action? t)
+                args)))
+      args)))
+
+(defun guix-command-rest-argument (&optional commands)
+  "Return '--' argument for COMMANDS."
+  (cl-flet ((argument (&rest args)
+              (apply #'guix-command-make-argument
+                     :name "-- " :char ?= :option? t args)))
+    (let ((command (car commands)))
+      (cond
+       ((member command '("archive" "build" "edit" "environment"
+                          "lint" "refresh"))
+        (argument :doc "Packages" :fun 'guix-read-package-names-string))
+       ((string= command "download")
+        (argument :doc "URL"))
+       ((string= command "gc")
+        (argument :doc "Paths" :fun 'guix-read-file-name))
+       ((member command '("hash" "system"))
+        (argument :doc "File" :fun 'guix-read-file-name))
+       ((string= command "size")
+        (argument :doc "Package" :fun 'guix-read-package-name))
+       ((equal commands '("import" "nix"))
+        (argument :doc "Nixpkgs Attribute"))
+       ;; Other 'guix import' subcommands, but not 'import' itself.
+       ((and (cdr commands)
+             (string= command "import"))
+        (argument :doc "Package name"))))))
+
+(defun guix-command-default-action-argument (&optional commands)
+  "Return default 'execute' action argument for COMMANDS."
+  (guix-command-make-argument
+   :doc     (format "Execute '%s'" (guix-command-string commands))
+   :char    ?e
+   :fun     (guix-command-symbol `(,@commands "execute" "action"))
+   :action? t))
+
+(defun guix-command-additional-action-arguments (&optional commands)
+  "Return additional action arguments for COMMANDS."
+  ;; For future needs.
+  nil)
+
+(defun guix-command-add-arguments (arguments commands)
+  "Return ARGUMENTS for 'guix COMMANDS ...' with additional ones."
+  (let* ((rest-arg (guix-command-rest-argument commands))
+         (action-args (or (guix-command-additional-action-arguments
+                           commands)
+                          (unless (guix-command-actions arguments)
+                            (list (guix-command-default-action-argument
+                                   commands)))))
+         (args (append action-args arguments)))
+    (if rest-arg
+        (cons rest-arg args)
+      args)))
+
+(defun guix-command-arguments (&optional commands)
+  "Return list of arguments for 'guix COMMANDS ...'."
+  (guix-command-add-arguments
+   (guix-command-improve-arguments
+    (guix-command-parse-arguments commands)
+    commands)
+   commands))
+
+(defun guix-command-switch->popup-switch (switch)
+  "Return popup switch from command SWITCH argument."
+  (list (guix-command-argument-char switch)
+        (or (guix-command-argument-doc switch)
+            "Unknown")
+        (guix-command-argument-name switch)))
+
+(defun guix-command-option->popup-option (option)
+  "Return popup option from command OPTION argument."
+  (list (guix-command-argument-char option)
+        (or (guix-command-argument-doc option)
+            "Unknown")
+        (let ((name (guix-command-argument-name option)))
+          (if (string-match-p " \\'" name) ; ends with space
+              name
+            (concat name "=")))
+        (or (guix-command-argument-fun option)
+            'read-from-minibuffer)))
+
+(defun guix-command-action->popup-action (action)
+  "Return popup action from command ACTION argument."
+  (list (guix-command-argument-char action)
+        (or (guix-command-argument-doc action)
+            (guix-command-argument-name action))
+        (guix-command-argument-fun action)))
+
+(defun guix-command-sort-arguments (arguments)
+  "Sort ARGUMENTS by name in alphabetical order."
+  (sort arguments
+        (lambda (a1 a2)
+          (let ((name1 (guix-command-argument-name a1))
+                (name2 (guix-command-argument-name a2)))
+            (cond ((null name1) nil)
+                  ((null name2) t)
+                  (t (string< name1 name2)))))))
+
+;; Ideally the following 6 functions should be generated by a macro, but
+;; they are not because of the nuance with the names: 'option ->
+;; options' (OK); 'action -> actions' (OK); 'switch -> switchs' (not OK).
+
+(defun guix-command-switches (arguments)
+  "Return switches from ARGUMENTS."
+  (cl-remove-if-not #'guix-command-argument-switch? arguments))
+
+(defun guix-command-options (arguments)
+  "Return options from ARGUMENTS."
+  (cl-remove-if-not #'guix-command-argument-option? arguments))
+
+(defun guix-command-actions (arguments)
+  "Return actions from ARGUMENTS."
+  (cl-remove-if-not #'guix-command-argument-action? arguments))
+
+(defun guix-command-arguments->popup-switches (arguments)
+  "Return a list of sorted popup switches from ARGUMENTS."
+  (mapcar #'guix-command-switch->popup-switch
+          (guix-command-sort-arguments
+           (guix-command-switches arguments))))
+
+(defun guix-command-arguments->popup-options (arguments)
+  "Return a list of sorted popup options from ARGUMENTS."
+  (mapcar #'guix-command-option->popup-option
+          (guix-command-sort-arguments
+           (guix-command-options arguments))))
+
+(defun guix-command-arguments->popup-actions (arguments)
+  "Return a list of sorted popup actions from ARGUMENTS."
+  (mapcar #'guix-command-action->popup-action
+          (guix-command-sort-arguments
+           (guix-command-actions arguments))))
+
+(defun guix-command-post-process-args (args)
+  "Adjust appropriately command line ARGS returned from popup command."
+  ;; Split "--install foo bar" and similar strings into lists of strings.
+  (let* (rest
+         (rx (rx string-start
+                 (or "-- " "--install " "--remove ")))
+         (args (mapcar (lambda (arg)
+                         (if (string-match-p rx arg)
+                             (progn (push (split-string arg) rest)
+                                    nil)
+                           arg))
+                       args)))
+    (if rest
+        (apply #'append (delq nil args) rest)
+      args)))
+
+
+;;; 'Execute' functions
+
+(defvar guix-command-executer-alist
+  '((guix-environment-execute-action . guix-environment-execute))
+  "Alist of execute actions and functions used to execute guix commands.")
+
+(defun guix-command-executer (action-name)
+  "Return a name of the 'execute' function by ACTION-NAME."
+  (or (guix-get-key-val guix-command-executer-alist action-name)
+      'guix-execute-command))
+
+(defun guix-environment-execute (args)
+  "Execute 'guix ARGS ...' environment command in Guix REPL."
+  ;; As 'guix environment' tries to run another process, it may be not
+  ;; very useful to execute this command in Geiser REPL.
+
+  ;; It is possible to use special action(s) instead to receive the
+  ;; environment synchronously and then to use it for starting 'shell'
+  ;; in another buffer.  However since the 'guix environment' process
+  ;; may take a very long time (because of building/downloading), this
+  ;; also doesn't look like a reasonable option.
+  (when (or (member "--dry-run" args)
+            (member "--search-paths" args)
+            (when (y-or-n-p
+                   "'guix environment' is going to spawn external process.
+Do you really want to execute this command in Geiser REPL? ")
+              (message "May \"M-x shell-mode\" be with you!")
+              t))
+    (guix-execute-command args)))
+
+
+;;; Generating popups, actions, etc.
+
+(defmacro guix-command-define-popup-action (name &optional commands)
+  "Define NAME function to generate (if needed) and run popup for COMMANDS."
+  (declare (indent 1) (debug t))
+  (let* ((popup-fun (guix-command-symbol `(,@commands "popup")))
+         (doc (format "Call `%s' (generate it if needed)."
+                      popup-fun)))
+    `(defun ,name (&optional arg)
+       ,doc
+       (interactive "P")
+       (unless (fboundp ',popup-fun)
+         (guix-command-generate-popup ',popup-fun ',commands))
+       (funcall ',popup-fun arg))))
+
+(defmacro guix-command-define-execute-action
+    (name arguments-fun execute-fun &optional commands)
+  "Define NAME function to run EXECUTE-FUN for guix COMMANDS.
+ARGUMENTS-FUN is `...-arguments' function for the current popup."
+  (declare (indent 1) (debug t))
+  (let ((doc (format "Call `%s' with the current popup arguments."
+                     execute-fun)))
+    `(defun ,name (&rest args)
+       ,doc
+       (interactive (,arguments-fun))
+       (,execute-fun (append ',commands
+                             (guix-command-post-process-args args))))))
+
+(defun guix-command-generate-actions (actions &optional commands)
+  "Generate action functions from ACTIONS arguments for guix COMMANDS.
+Generate 'popup' actions for complex commands, and 'execute'
+actions for the other commands."
+  (let ((popup? (guix-command-complex-p commands)))
+    (dolist (action actions)
+      (let ((fun (guix-command-argument-fun action)))
+        (unless (fboundp fun)
+          (let* ((name (guix-command-argument-name action))
+                 (cmds (if name
+                           (append commands (list name))
+                         commands)))
+            (eval (if popup?
+                      `(guix-command-define-popup-action ,fun ,cmds)
+                    `(guix-command-define-execute-action ,fun
+                       ,(guix-command-symbol `(,@commands "arguments"))
+                       ,(guix-command-executer fun)
+                       ,cmds)))))))))
+
+(defun guix-command-generate-popup (name &optional commands)
+  "Define NAME popup with 'guix COMMANDS ...' interface."
+  (let* ((command  (car commands))
+         (man-page (concat "guix" (and command (concat "-" command))))
+         (doc      (format "Popup window for '%s' command."
+                           (guix-concat-strings (cons "guix" commands)
+                                                " ")))
+         (args     (guix-command-arguments commands)))
+    (guix-command-generate-actions (guix-command-actions args) commands)
+    (eval
+     `(guix-define-popup ,name
+        ,doc
+        'guix-commands
+        :man-page ,man-page
+        :switches ',(guix-command-arguments->popup-switches args)
+        :options  ',(guix-command-arguments->popup-options  args)
+        :actions  ',(guix-command-arguments->popup-actions  args)
+        :max-action-columns 4))))
+
+;;;###autoload (autoload 'guix "guix-command" "Popup window for 'guix'." t)
+(guix-command-define-popup-action guix)
+
+
+(defvar guix-command-font-lock-keywords
+  (eval-when-compile
+    `((,(rx "("
+            (group "guix-command-define-"
+                   (or "popup-action"
+                       "execute-action"
+                       "argument-improver"))
+            symbol-end
+            (zero-or-more blank)
+            (zero-or-one
+             (group (one-or-more (or (syntax word) (syntax symbol))))))
+       (1 font-lock-keyword-face)
+       (2 font-lock-function-name-face nil t)))))
+
+(font-lock-add-keywords 'emacs-lisp-mode guix-command-font-lock-keywords)
+
+(provide 'guix-command)
+
+;;; guix-command.el ends here
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
index 8960630..96ee2cb 100644
--- a/emacs/guix-utils.el
+++ b/emacs/guix-utils.el
@@ -144,6 +144,14 @@ add both to the end and to the beginning."
           (t
            (concat separator str separator)))))
 
+(defun guix-command-symbol (&optional args)
+  "Return symbol by concatenating 'guix' and ARGS (strings)."
+  (intern (guix-concat-strings (cons "guix" args) "-")))
+
+(defun guix-command-string (&optional args)
+  "Return 'guix ARGS ...' string."
+  (guix-concat-strings (cons "guix" args) " "))
+
 (defun guix-completing-read-multiple (prompt table &optional predicate
                                       require-match initial-input
                                       hist def inherit-input-method)