01/03: emacs: Improve post processing of popup arguments.

[Alex Kost]

alezost pushed a commit to branch master
in repository guix.

commit 959c78f69a498b1cc558d6c8e6bc3faa78dd5423
Author: Alex Kost <address@hidden>
Date:   Wed Nov 4 21:40:31 2015 +0300

    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.
---
 emacs/guix-command.el |   99 +++++++++++++++++++++++++++++++++++++++++--------
 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 f8a6df7..ea29461 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 d1f088b..5f3f3ec 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