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.
This commit is contained in:
parent
1f13861b57
commit
9b0afb0d28
|
@ -9,6 +9,7 @@ Guix convenient and fun.
|
||||||
@menu
|
@menu
|
||||||
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
||||||
* Package Management: Emacs Package Management. Managing packages and generations.
|
* 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.
|
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
||||||
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
||||||
@end menu
|
@end menu
|
||||||
|
@ -35,6 +36,12 @@ later;
|
||||||
@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
|
@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
|
||||||
used for interacting with the Guile process.
|
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
|
@end itemize
|
||||||
|
|
||||||
When it is done ``guix.el'' may be configured by requiring a special
|
When it is done ``guix.el'' may be configured by requiring a special
|
||||||
|
@ -486,6 +493,43 @@ Various settings for ``info'' buffers.
|
||||||
@end table
|
@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
|
@node Emacs Prettify
|
||||||
@section Guix Prettify Mode
|
@section Guix Prettify Mode
|
||||||
|
|
||||||
|
|
|
@ -112,6 +112,7 @@ Emacs Interface
|
||||||
|
|
||||||
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
||||||
* Package Management: Emacs Package Management. Managing packages and generations.
|
* 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.
|
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
||||||
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
||||||
|
|
||||||
|
|
1
emacs.am
1
emacs.am
|
@ -21,6 +21,7 @@ AUTOLOADS = emacs/guix-autoloads.el
|
||||||
ELFILES = \
|
ELFILES = \
|
||||||
emacs/guix-backend.el \
|
emacs/guix-backend.el \
|
||||||
emacs/guix-base.el \
|
emacs/guix-base.el \
|
||||||
|
emacs/guix-command.el \
|
||||||
emacs/guix-emacs.el \
|
emacs/guix-emacs.el \
|
||||||
emacs/guix-help-vars.el \
|
emacs/guix-help-vars.el \
|
||||||
emacs/guix-history.el \
|
emacs/guix-history.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
|
Loading…
Reference in New Issue