aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--emacs/guix-command.el99
-rw-r--r--emacs/guix-utils.el11
2 files changed, 94 insertions, 16 deletions
diff --git a/emacs/guix-command.el b/emacs/guix-command.el
index f8a6df7c6a..ea294611e0 100644
--- a/emacs/guix-command.el
+++ b/emacs/guix-command.el
@@ -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."
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
index d1f088b6a8..5f3f3ecc10 100644
--- a/emacs/guix-utils.el
+++ b/emacs/guix-utils.el
@@ -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