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."
|
||||
(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 ")))
|
||||
|
||||
;;; Post processing popup arguments
|
||||
|
||||
(defvar guix-command-post-processors
|
||||
'(("hash"
|
||||
guix-command-post-process-rest-single)
|
||||
("package"
|
||||
guix-command-post-process-package-args)
|
||||
("system"
|
||||
guix-command-post-process-rest-single))
|
||||
"Alist of guix commands and functions for post-processing
|
||||
a list of arguments returned from popup interface.
|
||||
Each function is called on the returned arguments in turn.")
|
||||
|
||||
(defvar guix-command-rest-arg-regexp
|
||||
(rx string-start "-- " (group (+ any)))
|
||||
"Regexp to match a string with the 'rest' arguments.")
|
||||
|
||||
(defun guix-command-replace-args (args predicate modifier)
|
||||
"Replace arguments matching PREDICATE from ARGS.
|
||||
Call MODIFIER on each argument matching PREDICATE and append the
|
||||
returned list of strings to the end of ARGS. Remove the original
|
||||
arguments."
|
||||
(let* ((rest nil)
|
||||
(args (mapcar (lambda (arg)
|
||||
(if (string-match-p rx arg)
|
||||
(progn (push (split-string arg) rest)
|
||||
nil)
|
||||
(if (funcall predicate arg)
|
||||
(progn
|
||||
(push (funcall modifier arg) rest)
|
||||
nil)
|
||||
arg))
|
||||
args)))
|
||||
(if rest
|
||||
(apply #'append (delq nil args) rest)
|
||||
args)))
|
||||
|
||||
(cl-defun guix-command-post-process-matching-args (args regexp
|
||||
&key group split?)
|
||||
"Modify arguments from ARGS matching REGEXP by moving them to
|
||||
the end of ARGS list. If SPLIT? is non-nil, split matching
|
||||
arguments into multiple subarguments."
|
||||
(guix-command-replace-args
|
||||
args
|
||||
(lambda (arg)
|
||||
(string-match regexp arg))
|
||||
(lambda (arg)
|
||||
(let ((val (match-string (or group 0) arg))
|
||||
(fun (if split? #'split-string #'list)))
|
||||
(funcall fun val)))))
|
||||
|
||||
(defun guix-command-post-process-rest-single (args)
|
||||
"Modify ARGS by moving '-- ARG' argument to the end of ARGS list."
|
||||
(guix-command-post-process-matching-args
|
||||
args guix-command-rest-arg-regexp
|
||||
:group 1))
|
||||
|
||||
(defun guix-command-post-process-rest-multiple (args)
|
||||
"Modify ARGS by splitting '-- ARG ...' into multiple subarguments
|
||||
and moving them to the end of ARGS list.
|
||||
Remove '-- ' string."
|
||||
(guix-command-post-process-matching-args
|
||||
args guix-command-rest-arg-regexp
|
||||
:group 1
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-rest-multiple-leave (args)
|
||||
"Modify ARGS by splitting '-- ARG ...' into multiple subarguments
|
||||
and moving them to the end of ARGS list.
|
||||
Leave '--' string as a separate argument."
|
||||
(guix-command-post-process-matching-args
|
||||
args guix-command-rest-arg-regexp
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-package-args (args)
|
||||
"Adjust popup ARGS for 'guix package' command."
|
||||
(guix-command-post-process-matching-args
|
||||
args (rx string-start (or "--install " "--remove ") (+ any))
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-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
|
||||
|
||||
|
@ -642,7 +708,8 @@ EXECUTOR function is called with the current command line arguments."
|
|||
,doc
|
||||
(interactive (,arguments-fun))
|
||||
(,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)
|
||||
"Generate 'popup' commands from ACTIONS arguments for guix COMMANDS."
|
||||
|
|
|
@ -226,6 +226,17 @@ single argument."
|
|||
(while (re-search-forward ,regexp nil t)
|
||||
,@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
|
||||
|
||||
|
|
Loading…
Reference in New Issue