summary refs log tree commit diff
path: root/emacs/guix-command.el
diff options
context:
space:
mode:
authorLeo Famulari <leo@famulari.name>2017-01-06 17:14:41 -0500
committerLeo Famulari <leo@famulari.name>2017-01-06 17:14:41 -0500
commit74288230ea8b2310495dc2739f39ceadcc143fd0 (patch)
tree73ba6c7c13d59c5f92b409c94dccfff159e08f4d /emacs/guix-command.el
parent92e779592d269ca1924f184496eb4ca832997b12 (diff)
parentaa21c764d65068783ae31febee2a92eb3d138a24 (diff)
downloadguix-74288230ea8b2310495dc2739f39ceadcc143fd0.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'emacs/guix-command.el')
-rw-r--r--emacs/guix-command.el830
1 files changed, 0 insertions, 830 deletions
diff --git a/emacs/guix-command.el b/emacs/guix-command.el
deleted file mode 100644
index 7069c51649..0000000000
--- a/emacs/guix-command.el
+++ /dev/null
@@ -1,830 +0,0 @@
-;;; guix-command.el --- Popup interface for guix commands  -*- lexical-binding: t -*-
-
-;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; 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
-;; special readers should be used for some options (for example, to
-;; complete package names while prompting for a package).  So after
-;; parsing --help output, the arguments are "improved".  All arguments
-;; (switches, options and actions) are `guix-command-argument'
-;; structures.
-
-;; 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 the plain "guix" without
-;; subcommands.
-
-;; All actions in popup windows are divided into 2 groups:
-;;
-;; - 'Popup' actions - used to pop up another window.  For example, every
-;;   action in the 'guix' or 'guix import' window is a popup action.  They
-;;   are defined by `guix-command-define-popup-action' macro.
-;;
-;; - 'Execute' actions - used to do something with the command line (to
-;;   run a command in Guix REPL or to copy it into kill-ring) constructed
-;;   with the current popup.  They are defined by
-;;   `guix-command-define-execute-action' macro.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-popup)
-(require 'guix-utils)
-(require 'guix-help-vars)
-(require 'guix-read)
-(require 'guix-base)
-(require 'guix-build-log)
-(require 'guix-guile)
-(require 'guix-external)
-
-(defgroup guix-commands nil
-  "Settings for guix popup windows."
-  :group 'guix)
-
-(defvar guix-command-complex-with-shared-arguments
-  '("system")
-  "List of guix commands which have subcommands with shared options.
-I.e., 'guix foo --help' is the same as 'guix foo bar --help'.")
-
-(defun guix-command-action-name (&optional commands &rest name-parts)
-  "Return name of action function for guix COMMANDS."
-  (guix-command-symbol (append commands name-parts (list "action"))))
-
-
-;;; 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 (guix-assoc-value alist name)))
-    (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
-  '(("container"   :char ?C)
-    ("graph"       :char ?G)
-    ("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
-  '(("--no-substitutes"  :char ?s)
-    ("--no-build-hook"   :char ?h)
-    ("--max-silent-time" :char ?x)
-    ("--rounds"          :char ?R :fun read-number)
-    ("--with-input"      :char ?W)))
-
-(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)
-    ("--file"        :fun guix-read-file-name)
-    ("--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
-  '(("--ad-hoc"
-     :name "--ad-hoc " :fun guix-read-package-names-string
-     :switch? nil :option? t)
-    ("--expose" :char ?E)
-    ("--share" :char ?S)
-    ("--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-graph-argument
-  '(("--type" :fun guix-read-graph-type)))
-
-(guix-command-define-argument-improver
-    guix-command-improve-import-argument
-  '(("cran" :char ?r)))
-
-(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)
-    ("--install-from-file" :fun guix-read-file-name)
-    ("--manifest"       :fun guix-read-file-name)
-    ("--profile"        :fun guix-read-file-name)
-    ("--do-not-upgrade" :char ?U)
-    ("--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)
-    ("--type"       :fun guix-read-refresh-updater-names-string)
-    ("--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
-  '(("disk-image"  :char ?D)
-    ("vm-image"    :char ?V)
-    ("--on-error"  :char ?E)
-    ("--no-grub"   :char ?g)
-    ("--full-boot" :char ?b)))
-
-(defvar guix-command-argument-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)
-    (("graph")
-     guix-command-improve-graph-argument)
-    (("import")
-     guix-command-improve-import-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-improve-argument (argument improvers)
-  "Return ARGUMENT modified with IMPROVERS."
-  (or (cl-some (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-assoc-value 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-action-name commands name)
-                 :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" "challenge" "edit"
-                  "graph" "lint" "refresh"))
-        (argument :doc "Packages" :fun 'guix-read-package-names-string))
-       ((equal commands '("container" "exec"))
-        (argument :doc "PID Command [Args...]"))
-       ((string= command "download")
-        (argument :doc "URL"))
-       ((string= command "environment")
-        (argument :doc "Command [Args...]" :fun 'read-shell-command))
-       ((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"))))))
-
-(defvar guix-command-additional-arguments
-  `((("environment")
-     ,(guix-command-make-argument
-       :name "++packages " :char ?p :option? t
-       :doc "build inputs of the specified packages"
-       :fun 'guix-read-package-names-string)))
-  "Alist of guix commands and additional arguments for them.
-These are 'fake' arguments that are not presented in 'guix' shell
-commands.")
-
-(defun guix-command-additional-arguments (&optional commands)
-  "Return additional arguments for COMMANDS."
-  (let ((rest-arg (guix-command-rest-argument commands)))
-    (append (guix-assoc-value guix-command-additional-arguments
-                              commands)
-            (and rest-arg (list rest-arg)))))
-
-;; Ideally only `guix-command-arguments' function should exist with the
-;; contents of `guix-command-all-arguments', but we need to make a
-;; special case for `guix-command-complex-with-shared-arguments' commands.
-
-(defun guix-command-all-arguments (&optional commands)
-  "Return list of all arguments for 'guix COMMANDS ...'."
-  (let ((parsed (guix-command-parse-arguments commands)))
-    (append (guix-command-improve-arguments parsed commands)
-            (guix-command-additional-arguments commands))))
-
-(guix-memoized-defalias guix-command-all-arguments-memoize
-  guix-command-all-arguments)
-
-(defun guix-command-arguments (&optional commands)
-  "Return list of arguments for 'guix COMMANDS ...'."
-  (let ((command (car commands)))
-    (if (member command
-                guix-command-complex-with-shared-arguments)
-        ;; Take actions only for 'guix system', and switches+options for
-        ;; 'guix system foo'.
-        (funcall (if (null (cdr commands))
-                     #'cl-remove-if-not
-                   #'cl-remove-if)
-                 #'guix-command-argument-action?
-                 (guix-command-all-arguments-memoize (list command)))
-      (guix-command-all-arguments 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)
-            "Unknown")
-        (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)))))))
-
-(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))
-
-
-;;; Post processing popup arguments
-
-(defvar guix-command-post-processors
-  '(("environment"
-     guix-command-post-process-environment-packages
-     guix-command-post-process-environment-ad-hoc
-     guix-command-post-process-rest-multiple-leave)
-    ("hash"
-     guix-command-post-process-rest-single)
-    ("package"
-     guix-command-post-process-package-args)
-    ("system"
-     guix-command-post-process-rest-single))
-  "Alist of guix commands and functions for post-processing
-a list of arguments returned from popup interface.
-Each function is called on the returned arguments in turn.")
-
-(defvar guix-command-rest-arg-regexp
-  (rx string-start "-- " (group (+ any)))
-  "Regexp to match a string with the 'rest' arguments.")
-
-(defun guix-command-replace-args (args predicate modifier)
-  "Replace arguments matching PREDICATE from ARGS.
-Call MODIFIER on each argument matching PREDICATE and append the
-returned list of strings to the end of ARGS.  Remove the original
-arguments."
-  (let* ((rest nil)
-         (args (mapcar (lambda (arg)
-                         (if (funcall predicate arg)
-                             (progn
-                               (push (funcall modifier arg) rest)
-                               nil)
-                           arg))
-                       args)))
-    (if rest
-        (apply #'append (delq nil args) rest)
-      args)))
-
-(cl-defun guix-command-post-process-matching-args (args regexp
-                                                   &key group split?)
-  "Modify arguments from ARGS matching REGEXP by moving them to
-the end of ARGS list.  If SPLIT? is non-nil, split matching
-arguments into multiple subarguments."
-  (guix-command-replace-args
-   args
-   (lambda (arg)
-     (string-match regexp arg))
-   (lambda (arg)
-     (let ((val (match-string (or group 0) arg))
-           (fun (if split? #'split-string #'list)))
-       (funcall fun val)))))
-
-(defun guix-command-post-process-rest-single (args)
-  "Modify ARGS by moving '-- ARG' argument to the end of ARGS list."
-  (guix-command-post-process-matching-args
-   args guix-command-rest-arg-regexp
-   :group 1))
-
-(defun guix-command-post-process-rest-multiple (args)
-  "Modify ARGS by splitting '-- ARG ...' into multiple subarguments
-and moving them to the end of ARGS list.
-Remove '-- ' string."
-  (guix-command-post-process-matching-args
-   args guix-command-rest-arg-regexp
-   :group 1
-   :split? t))
-
-(defun guix-command-post-process-rest-multiple-leave (args)
-  "Modify ARGS by splitting '-- ARG ...' into multiple subarguments
-and moving them to the end of ARGS list.
-Leave '--' string as a separate argument."
-  (guix-command-post-process-matching-args
-   args guix-command-rest-arg-regexp
-   :split? t))
-
-(defun guix-command-post-process-package-args (args)
-  "Adjust popup ARGS for 'guix package' command."
-  (guix-command-post-process-matching-args
-   args (rx string-start (or "--install " "--remove ") (+ any))
-   :split? t))
-
-(defun guix-command-post-process-environment-packages (args)
-  "Adjust popup ARGS for specified packages of 'guix environment'
-command."
-  (guix-command-post-process-matching-args
-   args (rx string-start "++packages " (group (+ any)))
-   :group 1
-   :split? t))
-
-(defun guix-command-post-process-environment-ad-hoc (args)
-  "Adjust popup ARGS for '--ad-hoc' argument of 'guix environment'
-command."
-  (guix-command-post-process-matching-args
-   args (rx string-start "--ad-hoc " (+ any))
-   :split? t))
-
-(defun guix-command-post-process-args (commands args)
-  "Adjust popup ARGS for guix COMMANDS."
-  (let* ((command (car commands))
-         (processors
-          (append (guix-assoc-value guix-command-post-processors commands)
-                  (guix-assoc-value guix-command-post-processors command))))
-    (guix-modify args
-                 (or processors
-                     (list #'guix-command-post-process-rest-multiple)))))
-
-
-;;; 'Execute' actions
-
-(defvar guix-command-default-execute-arguments
-  (list
-   (guix-command-make-argument
-    :name "repl"  :char ?r :doc "Run in Guix REPL")
-   (guix-command-make-argument
-    :name "shell" :char ?s :doc "Run in shell")
-   (guix-command-make-argument
-    :name "copy"  :char ?c :doc "Copy command line"))
-  "List of default 'execute' action arguments.")
-
-(defvar guix-command-additional-execute-arguments
-  (let ((graph-arg (guix-command-make-argument
-                    :name "view" :char ?v :doc "View graph")))
-    `((("build")
-       ,(guix-command-make-argument
-         :name "log" :char ?l :doc "View build log"))
-      (("graph") ,graph-arg)
-      (("size")
-       ,(guix-command-make-argument
-         :name "view" :char ?v :doc "View map"))
-      (("system" "shepherd-graph") ,graph-arg)
-      (("system" "extension-graph") ,graph-arg)))
-  "Alist of guix commands and additional 'execute' action arguments.")
-
-(defun guix-command-execute-arguments (commands)
-  "Return a list of 'execute' action arguments for COMMANDS."
-  (mapcar (lambda (arg)
-            (guix-command-modify-argument arg
-              :action? t
-              :fun (guix-command-action-name
-                    commands (guix-command-argument-name arg))))
-          (append guix-command-default-execute-arguments
-                  (guix-assoc-value
-                   guix-command-additional-execute-arguments commands))))
-
-(defvar guix-command-special-executors
-  '((("environment")
-     ("repl" . guix-run-environment-command-in-repl))
-    (("pull")
-     ("repl" . guix-run-pull-command-in-repl))
-    (("build")
-     ("log" . guix-run-view-build-log))
-    (("graph")
-     ("view" . guix-run-view-graph))
-    (("size")
-     ("view" . guix-run-view-size-map))
-    (("system" "shepherd-graph")
-     ("view" . guix-run-view-graph))
-    (("system" "extension-graph")
-     ("view" . guix-run-view-graph)))
-  "Alist of guix commands and alists of special executers for them.
-See also `guix-command-default-executors'.")
-
-(defvar guix-command-default-executors
-  '(("repl"  . guix-run-command-in-repl)
-    ("shell" . guix-run-command-in-shell)
-    ("copy"  . guix-copy-command-as-kill))
-  "Alist of default executers for action names.")
-
-(defun guix-command-executor (commands name)
-  "Return function to run command line arguments for guix COMMANDS."
-  (or (guix-assoc-value guix-command-special-executors commands name)
-      (guix-assoc-value guix-command-default-executors name)))
-
-(defun guix-run-environment-command-in-repl (args)
-  "Run 'guix ARGS ...' environment command in Guix REPL."
-  ;; As 'guix environment' usually tries to run another process, it may
-  ;; be fun but not wise to run this command in Geiser REPL.
-  (when (or (member "--dry-run" args)
-            (member "--search-paths" args)
-            (when (y-or-n-p
-                   (format "'%s' command will spawn an external process.
-Do you really want to execute this command in Geiser REPL? "
-                           (guix-command-string args)))
-              (message "May \"M-x shell-mode\" be with you!")
-              t))
-    (guix-run-command-in-repl args)))
-
-(defun guix-run-pull-command-in-repl (args)
-  "Run 'guix ARGS ...' pull command in Guix REPL.
-Perform pull-specific actions after operation, see
-`guix-after-pull-hook' and `guix-update-after-pull'."
-  (guix-eval-in-repl
-   (apply #'guix-make-guile-expression 'guix-command args)
-   nil 'pull))
-
-(defun guix-run-view-build-log (args)
-  "Add --log-file to ARGS, run 'guix ARGS ...' build command, and
-open the log file(s)."
-  (let* ((args (if (member "--log-file" args)
-                   args
-                 (cl-list* (car args) "--log-file" (cdr args))))
-         (output (guix-command-output args))
-         (files  (split-string output "\n" t)))
-    (dolist (file files)
-      (guix-build-log-find-file file))))
-
-(defun guix-run-view-graph (args)
-  "Run 'guix ARGS ...' graph command, make the image and open it."
-  (let* ((graph-file (guix-dot-file-name))
-         (dot-args   (guix-dot-arguments graph-file)))
-    (if (guix-eval-read (guix-make-guile-expression
-                         'pipe-guix-output args dot-args))
-        (guix-find-file graph-file)
-      (error "Couldn't create a graph"))))
-
-(defun guix-run-view-size-map (args)
-  "Run 'guix ARGS ...' size command, and open the map file."
-  (let* ((wished-map-file
-          (cl-some (lambda (arg)
-                     (and (string-match "--map-file=\\(.+\\)" arg)
-                          (match-string 1 arg)))
-                   args))
-         (map-file (or wished-map-file (guix-png-file-name)))
-         (args (if wished-map-file
-                   args
-                 (cl-list* (car args)
-                           (concat "--map-file=" map-file)
-                           (cdr args)))))
-    (guix-command-output args)
-    (guix-find-file map-file)))
-
-
-;;; 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))
-       (,popup-fun arg))))
-
-(defmacro guix-command-define-execute-action (name executor
-                                                   &optional commands)
-  "Define NAME function to execute the current action for guix COMMANDS.
-EXECUTOR function is called with the current command line arguments."
-  (declare (indent 1) (debug t))
-  (let* ((arguments-fun (guix-command-symbol `(,@commands "arguments")))
-         (doc (format "Call `%s' with the current popup arguments."
-                      executor)))
-    `(defun ,name (&rest args)
-       ,doc
-       (interactive (,arguments-fun))
-       (,executor (append ',commands
-                          (guix-command-post-process-args
-                           ',commands args))))))
-
-(defun guix-command-generate-popup-actions (actions &optional commands)
-  "Generate 'popup' commands from ACTIONS arguments for guix COMMANDS."
-  (dolist (action actions)
-    (let ((fun (guix-command-argument-fun action)))
-      (unless (fboundp fun)
-        (eval `(guix-command-define-popup-action ,fun
-                 ,(append commands
-                          (list (guix-command-argument-name action)))))))))
-
-(defun guix-command-generate-execute-actions (actions &optional commands)
-  "Generate 'execute' commands from ACTIONS arguments for guix COMMANDS."
-  (dolist (action actions)
-    (let ((fun (guix-command-argument-fun action)))
-      (unless (fboundp fun)
-        (eval `(guix-command-define-execute-action ,fun
-                 ,(guix-command-executor
-                   commands (guix-command-argument-name action))
-                 ,commands))))))
-
-(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))
-         (switches (guix-command-sort-arguments
-                    (guix-command-switches args)))
-         (options  (guix-command-sort-arguments
-                    (guix-command-options args)))
-         (popup-actions (guix-command-sort-arguments
-                         (guix-command-actions args)))
-         (execute-actions (unless popup-actions
-                            (guix-command-execute-arguments commands)))
-         (actions (or popup-actions execute-actions)))
-    (if popup-actions
-        (guix-command-generate-popup-actions popup-actions commands)
-      (guix-command-generate-execute-actions execute-actions commands))
-    (eval
-     `(guix-define-popup ,name
-        ,doc
-        'guix-commands
-        :man-page ,man-page
-        :switches ',(mapcar #'guix-command-switch->popup-switch switches)
-        :options  ',(mapcar #'guix-command-option->popup-option options)
-        :actions  ',(mapcar #'guix-command-action->popup-action actions)
-        :max-action-columns 4))))
-
-;;;###autoload (autoload 'guix "guix-command" "Popup window for 'guix'." t)
-(guix-command-define-popup-action guix)
-
-(defalias 'guix-edit-action #'guix-edit)
-
-
-(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