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:
Alex Kost 2015-11-04 21:40:31 +03:00
parent 4f8f15cd5c
commit 959c78f69a
2 changed files with 94 additions and 16 deletions

View File

@ -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."

View File

@ -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