aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2015-08-14 10:47:10 +0300
committerAlex Kost <alezost@gmail.com>2015-08-30 18:26:03 +0300
commit9b0afb0d289c58233bbc1764097b88e7fab3724f (patch)
treeff48fe83f2cf66bfd359435b434a2c9c9ccaf08a
parent1f13861b579aadf6818f4388a9e9654c9637ae5c (diff)
downloadgnu-guix-9b0afb0d289c58233bbc1764097b88e7fab3724f.tar
gnu-guix-9b0afb0d289c58233bbc1764097b88e7fab3724f.tar.gz
emacs: Add popup interface for guix commands.
* emacs/guix-command.el: New file. * emacs.am (ELFILES): Add it. * doc/emacs.texi (Emacs Initial Setup): Mention 'magit-popup' library. (Emacs Popup Interface): New node. (Emacs Interface): Add it. * doc/guix.texi (Top): Likewise.
-rw-r--r--doc/emacs.texi44
-rw-r--r--doc/guix.texi1
-rw-r--r--emacs.am1
-rw-r--r--emacs/guix-command.el649
4 files changed, 695 insertions, 0 deletions
diff --git a/doc/emacs.texi b/doc/emacs.texi
index 5fa15d7783..db2e657d27 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
@@ -35,6 +36,12 @@ later;
@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
used for interacting with the Guile process.
+@item
+@uref{https://github.com/magit/magit/, magit-popup library}. You
+already have this library if you use Magit 2.1.0 or later. This library
+is an optional dependency---it is required only for @kbd{M-x@tie{}guix}
+command (@pxref{Emacs Popup Interface}).
+
@end itemize
When it is done ``guix.el'' may be configured by requiring a special
@@ -486,6 +493,43 @@ Various settings for ``info'' buffers.
@end table
+@node Emacs Popup Interface
+@section 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 @kbd{M-x@tie{}guix} command provides a top-level popup interface for
+all available guix commands. When you select an option, you'll be
+prompted for a value in the minibuffer. Many values have completions,
+so don't hesitate to press @key{TAB} key. Multiple values (for example,
+packages or lint checkers) should be separated by commas.
+
+After specifying all options and switches for a command, you may choose
+one of the available actions. The following default actions are
+available for all commands:
+
+@itemize
+
+@item
+Run the command in the Guix REPL. It is faster than running
+@code{guix@tie{}@dots{}} command directly in shell, as there is no
+need to run another guile process and to load required modules there.
+
+@item
+Run the command in a shell buffer. You can set
+@code{guix-run-in-shell-function} variable to fine tune the shell buffer
+you want to use.
+
+@item
+Add the command line to the kill ring (@pxref{Kill Ring,,, emacs, The
+GNU Emacs Manual}).
+
+@end itemize
+
+
@node Emacs Prettify
@section Guix Prettify Mode
diff --git a/doc/guix.texi b/doc/guix.texi
index cb5bbab2a0..89291273c4 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 e3f2001e8f..bf91cca0bb 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 0000000000..97a88726df
--- /dev/null
+++ b/emacs/guix-command.el
@@ -0,0 +1,649 @@
+;;; guix-command.el --- Popup interface for guix commands -*- lexical-binding: t -*-
+
+;; Copyright © 2015 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)
+
+(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
+ '(("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)))
+
+(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
+ '(("--exec" :fun read-shell-command)
+ ("--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-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)
+ ("--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)
+ ("--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-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" "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 (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-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" "graph" "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-additional-arguments (&optional commands)
+ "Return additional arguments for COMMANDS."
+ (let ((rest-arg (guix-command-rest-argument 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))
+
+(defun guix-command-post-process-args (args)
+ "Adjust appropriately command line ARGS returned from popup command."
+ ;; XXX We need to split "--install foo bar" and similar strings into
+ ;; lists of strings. But some commands (e.g., 'guix hash') accept a
+ ;; file name as the 'rest' argument, and as file names may contain
+ ;; spaces, splitting by spaces will break such names. For example, the
+ ;; following argument: "-- /tmp/file with spaces" will be transformed
+ ;; into the following list: ("--" "/tmp/file" "with" "spaces") instead
+ ;; of the wished ("--" "/tmp/file with spaces").
+ (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' 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
+ nil
+ "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)))
+ "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))
+
+
+;;; 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 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)
+
+
+(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