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.master
Alex Kost
parent
1f13861b57
commit
9b0afb0d28
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
1
emacs.am
1
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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Reference in New Issue