emacs: Improve post processing of popup arguments.
* emacs/guix-command.el (guix-command-switches, guix-command-rest-arg-regexp): New variables. (guix-command-post-processors, guix-command-post-process-matching-args, guix-command-post-process-rest-single, guix-command-post-process-rest-multiple, guix-command-post-process-rest-multiple-leave, guix-command-post-process-package-args): New functions. (guix-command-post-process-rest-multiple): Take 2 arguments. (guix-command-define-popup-action): Adjust accordingly. * emacs/guix-utils.el (guix-modify): New function.
This commit is contained in:
parent
4f8f15cd5c
commit
959c78f69a
|
@ -465,28 +465,94 @@ to be modified."
|
||||||
"Return actions from ARGUMENTS."
|
"Return actions from ARGUMENTS."
|
||||||
(cl-remove-if-not #'guix-command-argument-action? 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."
|
;;; Post processing popup arguments
|
||||||
;; XXX We need to split "--install foo bar" and similar strings into
|
|
||||||
;; lists of strings. But some commands (e.g., 'guix hash') accept a
|
(defvar guix-command-post-processors
|
||||||
;; file name as the 'rest' argument, and as file names may contain
|
'(("hash"
|
||||||
;; spaces, splitting by spaces will break such names. For example, the
|
guix-command-post-process-rest-single)
|
||||||
;; following argument: "-- /tmp/file with spaces" will be transformed
|
("package"
|
||||||
;; into the following list: ("--" "/tmp/file" "with" "spaces") instead
|
guix-command-post-process-package-args)
|
||||||
;; of the wished ("--" "/tmp/file with spaces").
|
("system"
|
||||||
(let* (rest
|
guix-command-post-process-rest-single))
|
||||||
(rx (rx string-start
|
"Alist of guix commands and functions for post-processing
|
||||||
(or "-- " "--install " "--remove ")))
|
a list of arguments returned from popup interface.
|
||||||
|
Each function is called on the returned arguments in turn.")
|
||||||
|
|
||||||
|
(defvar guix-command-rest-arg-regexp
|
||||||
|
(rx string-start "-- " (group (+ any)))
|
||||||
|
"Regexp to match a string with the 'rest' arguments.")
|
||||||
|
|
||||||
|
(defun guix-command-replace-args (args predicate modifier)
|
||||||
|
"Replace arguments matching PREDICATE from ARGS.
|
||||||
|
Call MODIFIER on each argument matching PREDICATE and append the
|
||||||
|
returned list of strings to the end of ARGS. Remove the original
|
||||||
|
arguments."
|
||||||
|
(let* ((rest nil)
|
||||||
(args (mapcar (lambda (arg)
|
(args (mapcar (lambda (arg)
|
||||||
(if (string-match-p rx arg)
|
(if (funcall predicate arg)
|
||||||
(progn (push (split-string arg) rest)
|
(progn
|
||||||
nil)
|
(push (funcall modifier arg) rest)
|
||||||
|
nil)
|
||||||
arg))
|
arg))
|
||||||
args)))
|
args)))
|
||||||
(if rest
|
(if rest
|
||||||
(apply #'append (delq nil args) rest)
|
(apply #'append (delq nil args) rest)
|
||||||
args)))
|
args)))
|
||||||
|
|
||||||
|
(cl-defun guix-command-post-process-matching-args (args regexp
|
||||||
|
&key group split?)
|
||||||
|
"Modify arguments from ARGS matching REGEXP by moving them to
|
||||||
|
the end of ARGS list. If SPLIT? is non-nil, split matching
|
||||||
|
arguments into multiple subarguments."
|
||||||
|
(guix-command-replace-args
|
||||||
|
args
|
||||||
|
(lambda (arg)
|
||||||
|
(string-match regexp arg))
|
||||||
|
(lambda (arg)
|
||||||
|
(let ((val (match-string (or group 0) arg))
|
||||||
|
(fun (if split? #'split-string #'list)))
|
||||||
|
(funcall fun val)))))
|
||||||
|
|
||||||
|
(defun guix-command-post-process-rest-single (args)
|
||||||
|
"Modify ARGS by moving '-- ARG' argument to the end of ARGS list."
|
||||||
|
(guix-command-post-process-matching-args
|
||||||
|
args guix-command-rest-arg-regexp
|
||||||
|
:group 1))
|
||||||
|
|
||||||
|
(defun guix-command-post-process-rest-multiple (args)
|
||||||
|
"Modify ARGS by splitting '-- ARG ...' into multiple subarguments
|
||||||
|
and moving them to the end of ARGS list.
|
||||||
|
Remove '-- ' string."
|
||||||
|
(guix-command-post-process-matching-args
|
||||||
|
args guix-command-rest-arg-regexp
|
||||||
|
:group 1
|
||||||
|
:split? t))
|
||||||
|
|
||||||
|
(defun guix-command-post-process-rest-multiple-leave (args)
|
||||||
|
"Modify ARGS by splitting '-- ARG ...' into multiple subarguments
|
||||||
|
and moving them to the end of ARGS list.
|
||||||
|
Leave '--' string as a separate argument."
|
||||||
|
(guix-command-post-process-matching-args
|
||||||
|
args guix-command-rest-arg-regexp
|
||||||
|
:split? t))
|
||||||
|
|
||||||
|
(defun guix-command-post-process-package-args (args)
|
||||||
|
"Adjust popup ARGS for 'guix package' command."
|
||||||
|
(guix-command-post-process-matching-args
|
||||||
|
args (rx string-start (or "--install " "--remove ") (+ any))
|
||||||
|
:split? t))
|
||||||
|
|
||||||
|
(defun guix-command-post-process-args (commands args)
|
||||||
|
"Adjust popup ARGS for guix COMMANDS."
|
||||||
|
(let* ((command (car commands))
|
||||||
|
(processors
|
||||||
|
(append (guix-assoc-value guix-command-post-processors commands)
|
||||||
|
(guix-assoc-value guix-command-post-processors command))))
|
||||||
|
(guix-modify args
|
||||||
|
(or processors
|
||||||
|
(list #'guix-command-post-process-rest-multiple)))))
|
||||||
|
|
||||||
|
|
||||||
;;; 'Execute' actions
|
;;; 'Execute' actions
|
||||||
|
|
||||||
|
@ -642,7 +708,8 @@ EXECUTOR function is called with the current command line arguments."
|
||||||
,doc
|
,doc
|
||||||
(interactive (,arguments-fun))
|
(interactive (,arguments-fun))
|
||||||
(,executor (append ',commands
|
(,executor (append ',commands
|
||||||
(guix-command-post-process-args args))))))
|
(guix-command-post-process-args
|
||||||
|
',commands args))))))
|
||||||
|
|
||||||
(defun guix-command-generate-popup-actions (actions &optional commands)
|
(defun guix-command-generate-popup-actions (actions &optional commands)
|
||||||
"Generate 'popup' commands from ACTIONS arguments for guix COMMANDS."
|
"Generate 'popup' commands from ACTIONS arguments for guix COMMANDS."
|
||||||
|
|
|
@ -226,6 +226,17 @@ single argument."
|
||||||
(while (re-search-forward ,regexp nil t)
|
(while (re-search-forward ,regexp nil t)
|
||||||
,@body)))
|
,@body)))
|
||||||
|
|
||||||
|
(defun guix-modify (object modifiers)
|
||||||
|
"Apply MODIFIERS to OBJECT.
|
||||||
|
OBJECT is passed as an argument to the first function from
|
||||||
|
MODIFIERS list, the returned result is passed to the second
|
||||||
|
function from the list and so on. Return result of the last
|
||||||
|
modifier call."
|
||||||
|
(if (null modifiers)
|
||||||
|
object
|
||||||
|
(guix-modify (funcall (car modifiers) object)
|
||||||
|
(cdr modifiers))))
|
||||||
|
|
||||||
|
|
||||||
;;; Alist accessors
|
;;; Alist accessors
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue