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,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."
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue