emacs/guix-pcomplete.el

   1 ;;; guix-pcomplete.el --- Functions for completing guix commands  -*- lexical-binding: t -*-
   2
   3 ;; Copyright © 2015 Alex Kost <alezost@gmail.com>
   4
   5 ;; This file is part of GNU Guix.
   6
   7 ;; GNU Guix is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Guix is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; This file provides completions for "guix" command that may be used in
  23 ;; `shell', `eshell' and wherever `pcomplete' works.
  24
  25 ;;; Code:
  26
  27 (require 'pcomplete)
  28 (require 'pcmpl-unix)
  29 (require 'cl-lib)
  30 (require 'guix-utils)
  31 (require 'guix-help-vars)
  32
  33 \f
  34 ;;; Interacting with guix
  35
  36 (defcustom guix-pcomplete-guix-program (executable-find "guix")
  37   "Name of the 'guix' program.
  38 It is used to find guix commands, options, packages, etc."
  39   :type 'file
  40   :group 'pcomplete
  41   :group 'guix)
  42
  43 (defun guix-pcomplete-run-guix (&rest args)
  44   "Run `guix-pcomplete-guix-program' with ARGS.
  45 Insert the output to the current buffer."
  46   (apply #'call-process
  47          guix-pcomplete-guix-program nil t nil args))
  48
  49 (defun guix-pcomplete-run-guix-and-search (regexp &optional group
  50                                                   &rest args)
  51   "Run `guix-pcomplete-guix-program' with ARGS and search for matches.
  52 Return a list of strings matching REGEXP.
  53 GROUP specifies a parenthesized expression used in REGEXP."
  54   (with-temp-buffer
  55     (apply #'guix-pcomplete-run-guix args)
  56     (let (result)
  57       (guix-while-search regexp
  58         (push (match-string-no-properties group) result))
  59       (nreverse result))))
  60
  61 (defmacro guix-pcomplete-define-options-finder (name docstring regexp
  62                                                      &optional filter)
  63   "Define function NAME to receive guix options and commands.
  64
  65 The defined function takes an optional COMMAND argument.  This
  66 function will run 'guix COMMAND --help' (or 'guix --help' if
  67 COMMAND is nil) using `guix-pcomplete-run-guix-and-search' and
  68 return its result.
  69
  70 If FILTER is specified, it should be a function.  The result is
  71 passed to this FILTER as argument and the result value of this
  72 function call is returned."
  73   (declare (doc-string 2) (indent 1))
  74   `(guix-memoized-defun ,name (&optional command)
  75      ,docstring
  76      (let* ((args '("--help"))
  77             (args (if command (cons command args) args))
  78             (res (apply #'guix-pcomplete-run-guix-and-search
  79                         ,regexp guix-help-parse-regexp-group args)))
  80        ,(if filter
  81             `(funcall ,filter res)
  82           'res))))
  83
  84 (guix-pcomplete-define-options-finder guix-pcomplete-commands
  85   "If COMMAND is nil, return a list of available guix commands.
  86 If COMMAND is non-nil (it should be a string), return available
  87 subcommands, actions, etc. for this guix COMMAND."
  88   guix-help-parse-command-regexp)
  89
  90 (guix-pcomplete-define-options-finder guix-pcomplete-long-options
  91   "Return a list of available long options for guix COMMAND."
  92   guix-help-parse-long-option-regexp)
  93
  94 (guix-pcomplete-define-options-finder guix-pcomplete-short-options
  95   "Return a string with available short options for guix COMMAND."
  96   guix-help-parse-short-option-regexp
  97   (lambda (list)
  98     (guix-concat-strings list "")))
  99
 100 (guix-memoized-defun guix-pcomplete-all-packages ()
 101   "Return a list of all available Guix packages."
 102   (guix-pcomplete-run-guix-and-search
 103    guix-help-parse-package-regexp
 104    guix-help-parse-regexp-group
 105    "package" "--list-available"))
 106
 107 (guix-memoized-defun guix-pcomplete-installed-packages (&optional profile)
 108   "Return a list of Guix packages installed in PROFILE."
 109   (let* ((args (and profile
 110                     (list (concat "--profile=" profile))))
 111          (args (append '("package" "--list-installed") args)))
 112     (apply #'guix-pcomplete-run-guix-and-search
 113            guix-help-parse-package-regexp
 114            guix-help-parse-regexp-group
 115            args)))
 116
 117 (guix-memoized-defun guix-pcomplete-lint-checkers ()
 118   "Return a list of all available lint checkers."
 119   (guix-pcomplete-run-guix-and-search
 120    guix-help-parse-list-regexp
 121    guix-help-parse-regexp-group
 122    "lint" "--list-checkers"))
 123
 124 (guix-memoized-defun guix-pcomplete-graph-types ()
 125   "Return a list of all available graph types."
 126   (guix-pcomplete-run-guix-and-search
 127    guix-help-parse-list-regexp
 128    guix-help-parse-regexp-group
 129    "graph" "--list-types"))
 130
 131 (guix-memoized-defun guix-pcomplete-refresh-updaters ()
 132   "Return a list of all available refresh updater types."
 133   (guix-pcomplete-run-guix-and-search
 134    guix-help-parse-list-regexp
 135    guix-help-parse-regexp-group
 136    "refresh" "--list-updaters"))
 137
 138 \f
 139 ;;; Completing
 140
 141 (defvar guix-pcomplete-option-regexp (rx string-start "-")
 142   "Regexp to match an option.")
 143
 144 (defvar guix-pcomplete-long-option-regexp (rx string-start "--")
 145   "Regexp to match a long option.")
 146
 147 (defvar guix-pcomplete-long-option-with-arg-regexp
 148   (rx string-start
 149       (group "--" (one-or-more any)) "="
 150       (group (zero-or-more any)))
 151   "Regexp to match a long option with its argument.
 152 The first parenthesized group defines the option and the second
 153 group - the argument.")
 154
 155 (defvar guix-pcomplete-short-option-with-arg-regexp
 156   (rx string-start
 157       (group "-" (not (any "-")))
 158       (group (zero-or-more any)))
 159   "Regexp to match a short option with its argument.
 160 The first parenthesized group defines the option and the second
 161 group - the argument.")
 162
 163 (defun guix-pcomplete-match-option ()
 164   "Return non-nil, if the current argument is an option."
 165   (pcomplete-match guix-pcomplete-option-regexp 0))
 166
 167 (defun guix-pcomplete-match-long-option ()
 168   "Return non-nil, if the current argument is a long option."
 169   (pcomplete-match guix-pcomplete-long-option-regexp 0))
 170
 171 (defun guix-pcomplete-match-long-option-with-arg ()
 172   "Return non-nil, if the current argument is a long option with value."
 173   (pcomplete-match guix-pcomplete-long-option-with-arg-regexp 0))
 174
 175 (defun guix-pcomplete-match-short-option-with-arg ()
 176   "Return non-nil, if the current argument is a short option with value."
 177   (pcomplete-match guix-pcomplete-short-option-with-arg-regexp 0))
 178
 179 (defun guix-pcomplete-long-option-arg (option args)
 180   "Return a long OPTION's argument from a list of arguments ARGS."
 181   (let* ((re (concat "\\`" option "=\\(.*\\)"))
 182          (args (cl-member-if (lambda (arg)
 183                                (string-match re arg))
 184                              args))
 185          (cur (car args)))
 186     (when cur
 187       (match-string-no-properties 1 cur))))
 188
 189 (defun guix-pcomplete-short-option-arg (option args)
 190   "Return a short OPTION's argument from a list of arguments ARGS."
 191   (let* ((re (concat "\\`" option "\\(.*\\)"))
 192          (args (cl-member-if (lambda (arg)
 193                                (string-match re arg))
 194                              args))
 195          (cur (car args)))
 196     (when cur
 197       (let ((arg (match-string-no-properties 1 cur)))
 198         (if (string= "" arg)
 199             (cadr args)                 ; take the next arg
 200           arg)))))
 201
 202 (defun guix-pcomplete-complete-comma-args (entries)
 203   "Complete comma separated arguments using ENTRIES."
 204   (let ((index pcomplete-index))
 205     (while (= index pcomplete-index)
 206       (let* ((args (if (or (guix-pcomplete-match-long-option-with-arg)
 207                            (guix-pcomplete-match-short-option-with-arg))
 208                        (pcomplete-match-string 2 0)
 209                      (pcomplete-arg 0)))
 210              (input (if (string-match ".*,\\(.*\\)" args)
 211                         (match-string-no-properties 1 args)
 212                       args)))
 213         (pcomplete-here* entries input)))))
 214
 215 (defun guix-pcomplete-complete-command-arg (command)
 216   "Complete argument for guix COMMAND."
 217   (cond
 218    ((member command
 219             '("archive" "build" "challenge" "edit" "environment"
 220               "graph" "lint" "refresh" "size"))
 221     (while t
 222       (pcomplete-here (guix-pcomplete-all-packages))))
 223    (t (pcomplete-here* (pcomplete-entries)))))
 224
 225 (defun guix-pcomplete-complete-option-arg (command option &optional input)
 226   "Complete argument for COMMAND's OPTION.
 227 INPUT is the current partially completed string."
 228   (cl-flet ((option? (short long)
 229               (or (string= option short)
 230                   (string= option long)))
 231             (command? (&rest commands)
 232               (member command commands))
 233             (complete (entries)
 234               (pcomplete-here entries input nil t))
 235             (complete* (entries)
 236               (pcomplete-here* entries input t)))
 237     (cond
 238      ((option? "-L" "--load-path")
 239       (complete* (pcomplete-dirs)))
 240      ((string= "--key-download" option)
 241       (complete* guix-help-key-policies))
 242
 243      ((command? "package")
 244       (cond
 245        ;; For '--install[=]' and '--remove[=]', try to complete a package
 246        ;; name (INPUT) after the "=" sign, and then the rest packages
 247        ;; separated with spaces.
 248        ((option? "-i" "--install")
 249         (complete (guix-pcomplete-all-packages))
 250         (while (not (guix-pcomplete-match-option))
 251           (pcomplete-here (guix-pcomplete-all-packages))))
 252        ((option? "-r" "--remove")
 253         (let* ((profile (or (guix-pcomplete-short-option-arg
 254                              "-p" pcomplete-args)
 255                             (guix-pcomplete-long-option-arg
 256                              "--profile" pcomplete-args)))
 257                (profile (and profile (expand-file-name profile))))
 258           (complete (guix-pcomplete-installed-packages profile))
 259           (while (not (guix-pcomplete-match-option))
 260             (pcomplete-here (guix-pcomplete-installed-packages profile)))))
 261        ((string= "--show" option)
 262         (complete (guix-pcomplete-all-packages)))
 263        ((option? "-p" "--profile")
 264         (complete* (pcomplete-dirs)))
 265        ((or (option? "-f" "--install-from-file")
 266             (option? "-m" "--manifest"))
 267         (complete* (pcomplete-entries)))))
 268
 269      ((and (command? "archive" "build" "size")
 270            (option? "-s" "--system"))
 271       (complete* guix-help-system-types))
 272
 273      ((and (command? "build")
 274            (or (option? "-f" "--file")
 275                (option? "-r" "--root")
 276                (string= "--with-source" option)))
 277       (complete* (pcomplete-entries)))
 278
 279      ((and (command? "graph")
 280            (option? "-t" "--type"))
 281       (complete* (guix-pcomplete-graph-types)))
 282
 283      ((and (command? "environment")
 284            (option? "-l" "--load"))
 285       (complete* (pcomplete-entries)))
 286
 287      ((and (command? "hash" "download")
 288            (option? "-f" "--format"))
 289       (complete* guix-help-hash-formats))
 290
 291      ((and (command? "lint")
 292            (option? "-c" "--checkers"))
 293       (guix-pcomplete-complete-comma-args
 294        (guix-pcomplete-lint-checkers)))
 295
 296      ((and (command? "publish")
 297            (option? "-u" "--user"))
 298       (complete* (pcmpl-unix-user-names)))
 299
 300      ((command? "refresh")
 301       (cond
 302        ((option? "-s" "--select")
 303         (complete* guix-help-refresh-subsets))
 304        ((option? "-t" "--type")
 305         (guix-pcomplete-complete-comma-args
 306          (guix-pcomplete-refresh-updaters)))))
 307
 308      ((and (command? "size")
 309            (option? "-m" "--map-file"))
 310       (complete* (pcomplete-entries))))))
 311
 312 (defun guix-pcomplete-complete-options (command)
 313   "Complete options (with their arguments) for guix COMMAND."
 314   (while (guix-pcomplete-match-option)
 315     (let ((index pcomplete-index))
 316       (if (guix-pcomplete-match-long-option)
 317
 318           ;; Long options.
 319           (if (guix-pcomplete-match-long-option-with-arg)
 320               (let ((option (pcomplete-match-string 1 0))
 321                     (arg    (pcomplete-match-string 2 0)))
 322                 (guix-pcomplete-complete-option-arg
 323                  command option arg))
 324
 325             (pcomplete-here* (guix-pcomplete-long-options command))
 326             ;; We support '--opt arg' style (along with '--opt=arg'),
 327             ;; because 'guix package --install/--remove' may be used this
 328             ;; way.  So try to complete an argument after the option has
 329             ;; been completed.
 330             (unless (guix-pcomplete-match-option)
 331               (guix-pcomplete-complete-option-arg
 332                command (pcomplete-arg 0 -1))))
 333
 334         ;; Short options.
 335         (let ((arg (pcomplete-arg 0)))
 336           (if (> (length arg) 2)
 337               ;; Support specifying an argument after a short option without
 338               ;; spaces (for example, '-L/tmp/foo').
 339               (guix-pcomplete-complete-option-arg
 340                command
 341                (substring-no-properties arg 0 2)
 342                (substring-no-properties arg 2))
 343             (pcomplete-opt (guix-pcomplete-short-options command))
 344             (guix-pcomplete-complete-option-arg
 345              command (pcomplete-arg 0 -1)))))
 346
 347       ;; If there were no completions, move to the next argument and get
 348       ;; out if the last argument is achieved.
 349       (when (= index pcomplete-index)
 350         (if (= pcomplete-index pcomplete-last)
 351             (throw 'pcompleted nil)
 352           (pcomplete-next-arg))))))
 353
 354 ;;;###autoload
 355 (defun pcomplete/guix ()
 356   "Completion for `guix'."
 357   (let ((commands (guix-pcomplete-commands)))
 358     (pcomplete-here* (cons "--help" commands))
 359     (let ((command (pcomplete-arg 'first 1)))
 360       (when (member command commands)
 361         (guix-pcomplete-complete-options command)
 362         (let ((subcommands (guix-pcomplete-commands command)))
 363           (when subcommands
 364             (pcomplete-here* subcommands)))
 365         (guix-pcomplete-complete-options command)
 366         (guix-pcomplete-complete-command-arg command)))))
 367
 368 (provide 'guix-pcomplete)
 369
 370 ;;; guix-pcomplete.el ends here