diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-command.el | 99 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 11 |
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 |