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
					
				
					 2 changed files with 94 additions and 16 deletions
				
			
		| 
						 | 
				
			
			@ -465,21 +465,34 @@ 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)
 | 
			
		||||
                         (if (funcall predicate arg)
 | 
			
		||||
                             (progn
 | 
			
		||||
                               (push (funcall modifier arg) rest)
 | 
			
		||||
                               nil)
 | 
			
		||||
                           arg))
 | 
			
		||||
                       args)))
 | 
			
		||||
| 
						 | 
				
			
			@ -487,6 +500,59 @@ to be modified."
 | 
			
		|||
        (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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue