lisp/pcmpl-rpm.el

   1 ;;; pcmpl-rpm.el --- functions for dealing with rpm completions
   2
   3 ;; Copyright (C) 1999-2018 Free Software Foundation, Inc.
   4
   5 ;; Package: pcomplete
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; These functions provide completion rules for the `rpm' command.
  25
  26 ;;; Code:
  27
  28 (require 'pcomplete)
  29
  30 (defgroup pcmpl-rpm nil
  31   "Options for rpm completion."
  32   :group 'pcomplete
  33   :prefix "pcmpl-rpm-")
  34
  35 ;; rpm -qa can be slow.  Adding --nodigest --nosignature is MUCH faster.
  36 (defcustom pcmpl-rpm-query-options
  37   (let (opts)
  38     (with-temp-buffer
  39       (when (ignore-errors (call-process "rpm" nil t nil "--help"))
  40         (if (search-backward "--nodigest " nil 'move)
  41             (setq opts '("--nodigest")))
  42         (goto-char (point-min))
  43         (if (search-forward "--nosignature " nil t)
  44             (push "--nosignature" opts))))
  45     opts)
  46   "String, or list of strings, with extra options for an rpm query command."
  47   :version "24.3"
  48   :type '(choice (const :tag "No options" nil)
  49                  (string :tag "Single option")
  50                  (repeat :tag "List of options" string))
  51   :group 'pcmpl-rpm)
  52
  53 (defcustom pcmpl-rpm-cache t
  54   "Whether to cache the list of installed packages."
  55   :version "24.3"
  56   :type 'boolean
  57   :group 'pcmpl-rpm)
  58
  59 (defconst pcmpl-rpm-cache-stamp-file "/var/lib/rpm/Packages"
  60   "File used to check that the list of installed packages is up-to-date.")
  61
  62 (defvar pcmpl-rpm-cache-time nil
  63   "Time at which the list of installed packages was updated.")
  64
  65 (defvar pcmpl-rpm-packages nil
  66   "List of installed packages.")
  67
  68 ;; Functions:
  69
  70 (defun pcmpl-rpm-packages ()
  71   "Return a list of all installed rpm packages."
  72   (if (and pcmpl-rpm-cache
  73            pcmpl-rpm-cache-time
  74            (let ((mtime (file-attribute-modification-time
  75                          (file-attributes pcmpl-rpm-cache-stamp-file))))
  76              (and mtime (not (time-less-p pcmpl-rpm-cache-time mtime)))))
  77       pcmpl-rpm-packages
  78     (message "Getting list of installed rpms...")
  79     (setq pcmpl-rpm-cache-time (current-time)
  80           pcmpl-rpm-packages
  81           (split-string (apply 'pcomplete-process-result "rpm"
  82                                (append '("-q" "-a")
  83                                        (if (stringp pcmpl-rpm-query-options)
  84                                            (list pcmpl-rpm-query-options)
  85                                          pcmpl-rpm-query-options)))))
  86     (message "Getting list of installed rpms...done")
  87     pcmpl-rpm-packages))
  88
  89 ;; Should this use pcmpl-rpm-query-options?
  90 ;; I don't think it would speed it up at all (?).
  91 (defun pcmpl-rpm-all-query (flag)
  92   (message "Querying all packages with `%s'..." flag)
  93   (let ((pkgs (pcmpl-rpm-packages))
  94         (provs (list t)))
  95     (while pkgs
  96       (nconc provs (split-string
  97                     (pcomplete-process-result
  98                      "rpm" "-q" (car pkgs) flag)))
  99       (setq pkgs (cdr pkgs)))
 100     (pcomplete-uniquify-list (cdr provs))))
 101
 102 (defsubst pcmpl-rpm-files ()
 103   (pcomplete-dirs-or-entries "\\.rpm\\'"))
 104
 105 ;;;###autoload
 106 (defun pcomplete/rpm ()
 107   "Completion for the `rpm' command."
 108   ;; Originally taken from the output of `rpm --help' on a Red Hat 6.1 system.
 109   (let (mode)
 110     (while (<= pcomplete-index pcomplete-last)
 111       (unless mode
 112         (if (pcomplete-match "^--\\(.*\\)" 0)
 113             (pcomplete-here*
 114              '("--addsign"
 115                "--checksig"
 116                "--erase"
 117                "--help"
 118                "--initdb"
 119                "--install"
 120                "--pipe"
 121                "--querytags"
 122                "--rebuild"
 123                "--rebuilddb"
 124                "--recompile"
 125                "--resign"
 126                "--rmsource"
 127                "--setperms"
 128                "--setugids"
 129                "--upgrade"
 130                "--verify"
 131                "--version"))
 132           (pcomplete-opt "vqVyiUebtK")))
 133 ;     -b<stage> <spec>
 134 ;     -t<stage> <tarball>    - build package, where <stage> is one of:
 135 ;         p                - prep (unpack sources and apply patches)
 136 ;         l                - list check (do some cursory checks on %files)
 137 ;         c                - compile (prep and compile)
 138 ;         i                - install (prep, compile, install)
 139 ;         b                - binary package (prep, compile, install, package)
 140 ;         a                - bin/src package (prep, compile, install, package)
 141       (cond
 142        ((or (eq mode 'query)
 143             (pcomplete-match "-[^-]*q"))
 144         (setq mode 'query)
 145         (if (pcomplete-match "^--\\(.*\\)" 0)
 146             (progn
 147               (pcomplete-here*
 148                '("--changelog"
 149                  "--dbpath"
 150                  "--dump"
 151                  "--file"
 152                  "--ftpport"            ;nyi for the next four
 153                  "--ftpproxy"
 154                  "--httpport"
 155                  "--httpproxy"
 156                  "--provides"
 157                  "--queryformat"
 158                  "--rcfile"
 159                  "--requires"
 160                  "--root"
 161                  "--scripts"
 162                  "--triggeredby"
 163                  "--whatprovides"
 164                  "--whatrequires"))
 165               (cond
 166                ((pcomplete-test "--dbpath")
 167                 (pcomplete-here* (pcomplete-dirs)))
 168                ((pcomplete-test "--queryformat")
 169                 (pcomplete-here*))
 170                ((pcomplete-test "--rcfile")
 171                 (pcomplete-here* (pcomplete-entries)))
 172                ((pcomplete-test "--file")
 173                 (pcomplete-here* (pcomplete-entries)))
 174                ((pcomplete-test "--root")
 175                 (pcomplete-here* (pcomplete-dirs)))
 176                ((pcomplete-test "--scripts")
 177                 (if (pcomplete-match "^--\\(.*\\)" 0)
 178                     (pcomplete-here* '("--triggers"))))
 179                ((pcomplete-test "--triggeredby")
 180                 (pcomplete-here* (pcmpl-rpm-packages)))
 181                ((pcomplete-test "--whatprovides")
 182                 (pcomplete-here*
 183                  (pcmpl-rpm-all-query "--provides")))
 184                ((pcomplete-test "--whatrequires")
 185                 (pcomplete-here*
 186                  (pcmpl-rpm-all-query "--requires")))))
 187           (if (pcomplete-match "^-" 0)
 188               (pcomplete-opt "af.p(pcmpl-rpm-files)ilsdcvR")
 189             (if (pcomplete-test "-[^-]*p" 'first 1)
 190                 (pcomplete-here (pcmpl-rpm-files))
 191               (if (pcomplete-test "-[^-]*f" 'first 1)
 192                   (pcomplete-here* (pcomplete-entries))
 193                 (pcomplete-here (pcmpl-rpm-packages)))))))
 194        ((pcomplete-test "--pipe")
 195         (pcomplete-here* (funcall pcomplete-command-completion-function)))
 196        ((pcomplete-test "--rmsource")
 197         (pcomplete-here* (pcomplete-entries))
 198         (throw 'pcomplete-completions nil))
 199        ((pcomplete-match "\\`--re\\(build\\|compile\\)\\'")
 200         (pcomplete-here (pcmpl-rpm-files))
 201         (throw 'pcomplete-completions nil))
 202        ((pcomplete-match "\\`--\\(resign\\|addsign\\)\\'")
 203         (while (pcomplete-here (pcmpl-rpm-files))))
 204        ((or (eq mode 'checksig)
 205             (pcomplete-test "--checksig"))
 206         (setq mode 'checksig)
 207         (if (pcomplete-match "^--\\(.*\\)" 0)
 208             (progn
 209               (pcomplete-here*
 210                '("--nopgp"
 211                  "--nogpg"
 212                  "--nomd5"
 213                  "--rcfile"))
 214               (cond
 215                ((pcomplete-test "--rcfile")
 216                 (pcomplete-here* (pcomplete-entries)))))
 217           (if (pcomplete-match "^-" 0)
 218               (pcomplete-opt "v")
 219             (pcomplete-here (pcmpl-rpm-files)))))
 220        ((or (eq mode 'rebuilddb)
 221             (pcomplete-test "--rebuilddb"))
 222         (setq mode 'rebuilddb)
 223         (if (pcomplete-match "^--\\(.*\\)" 0)
 224             (progn
 225               (pcomplete-here*
 226                '("--dbpath"
 227                  "--root"
 228                  "--rcfile"))
 229               (cond
 230                ((pcomplete-test "--dbpath")
 231                 (pcomplete-here* (pcomplete-dirs)))
 232                ((pcomplete-test "--root")
 233                 (pcomplete-here* (pcomplete-dirs)))
 234                ((pcomplete-test "--rcfile")
 235                 (pcomplete-here* (pcomplete-entries)))))
 236           (if (pcomplete-match "^-" 0)
 237               (pcomplete-opt "v")
 238             (pcomplete-here))))
 239        ((memq mode '(install upgrade))
 240         (if (pcomplete-match "^--\\(.*\\)" 0)
 241             (progn
 242               (pcomplete-here*
 243                (append
 244                 '("--allfiles"
 245                   "--badreloc"
 246                   "--dbpath"
 247                   "--excludedocs"
 248                   "--excludepath"
 249                   "--force"
 250                   "--hash"
 251                   "--ignorearch"
 252                   "--ignoreos"
 253                   "--ignoresize"
 254                   "--includedocs"
 255                   "--justdb"
 256                   "--nodeps"
 257                   "--noorder"
 258                   "--noscripts"
 259                   "--notriggers")
 260                 (if (eq mode 'upgrade)
 261                     '("--oldpackage"))
 262                 '("--percent"
 263                   "--prefix"
 264                   "--rcfile"
 265                   "--relocate"
 266                   "--replacefiles"
 267                   "--replacepkgs"
 268                   "--root")))
 269               (cond
 270                ((pcomplete-test "--dbpath")
 271                 (pcomplete-here* (pcomplete-dirs)))
 272                ((pcomplete-test "--relocate")
 273                 (pcomplete-here*))
 274                ((pcomplete-test "--rcfile")
 275                 (pcomplete-here* (pcomplete-entries)))
 276                ((pcomplete-test "--excludepath")
 277                 (pcomplete-here* (pcomplete-entries)))
 278                ((pcomplete-test "--root")
 279                 (pcomplete-here* (pcomplete-dirs)))
 280                ((pcomplete-test "--prefix")
 281                 (pcomplete-here* (pcomplete-dirs)))))
 282           (if (pcomplete-match "^-" 0)
 283               (pcomplete-opt "vh")
 284             (pcomplete-here (pcmpl-rpm-files)))))
 285        ((or (pcomplete-test "--install")
 286             (pcomplete-match "-[^-]*i"))
 287         (setq mode 'install))
 288        ((or (pcomplete-test "--upgrade")
 289             (pcomplete-match "-[^-]*U"))
 290         (setq mode 'upgrade))
 291        ((or (eq mode 'erase)
 292             (pcomplete-test "--erase")
 293             (pcomplete-match "-[^-]*e"))
 294         (setq mode 'erase)
 295         (if (pcomplete-match "^--\\(.*\\)" 0)
 296             (progn
 297               (pcomplete-here*
 298                '("--allmatches"
 299                  "--dbpath"
 300                  "--justdb"
 301                  "--nodeps"
 302                  "--noorder"
 303                  "--noscripts"
 304                  "--notriggers"
 305                  "--rcfile"
 306                  "--root"))
 307               (cond
 308                ((pcomplete-test "--dbpath")
 309                 (pcomplete-here* (pcomplete-dirs)))
 310                ((pcomplete-test "--rcfile")
 311                 (pcomplete-here* (pcomplete-entries)))
 312                ((pcomplete-test "--root")
 313                 (pcomplete-here* (pcomplete-dirs)))))
 314           (if (pcomplete-match "^-" 0)
 315               (pcomplete-opt "v")
 316             (pcomplete-here (pcmpl-rpm-packages)))))
 317        ((or (eq mode 'verify)
 318             (pcomplete-test "--verify"))
 319         (setq mode 'verify)
 320         (if (pcomplete-match "^--\\(.*\\)" 0)
 321             (progn
 322               (pcomplete-here*
 323                '("--dbpath"
 324                  "--nodeps"
 325                  "--nofiles"
 326                  "--nomd5"
 327                  "--rcfile"
 328                  "--root"
 329                  "--triggeredby"
 330                  "--whatprovides"
 331                  "--whatrequires"))
 332               (cond
 333                ((pcomplete-test "--dbpath")
 334                 (pcomplete-here* (pcomplete-dirs)))
 335                ((pcomplete-test "--rcfile")
 336                 (pcomplete-here* (pcomplete-entries)))
 337                ((pcomplete-test "--root")
 338                 (pcomplete-here* (pcomplete-dirs)))
 339                ((pcomplete-test "--triggeredby")
 340                 (pcomplete-here* (pcmpl-rpm-packages)))
 341                ((pcomplete-test "--whatprovides")
 342                 (pcomplete-here*
 343                  (pcmpl-rpm-all-query "--provides")))
 344                ((pcomplete-test "--whatrequires")
 345                 (pcomplete-here*
 346                  (pcmpl-rpm-all-query "--requires")))))
 347           (if (pcomplete-match "^-" 0)
 348               (pcomplete-opt "af.p(pcmpl-rpm-files)v")
 349             (pcomplete-here (pcmpl-rpm-packages)))))
 350        ((or (memq mode '(build test))
 351             (pcomplete-match "\\`-[bt]"))
 352         (setq mode (if (pcomplete-match "\\`-b")
 353                        'build
 354                      'test))
 355         (if (pcomplete-match "^--\\(.*\\)" 0)
 356             (progn
 357               (pcomplete-here*
 358                '("--buildroot"
 359                  "--clean"
 360                  "--nobuild"
 361                  "--rcfile"
 362                  "--rmsource"
 363                  "--short-circuit"
 364                  "--sign"
 365                  "--target"
 366                  "--timecheck"))
 367               (cond
 368                ((pcomplete-test "--buildroot")
 369                 (pcomplete-here* (pcomplete-dirs)))
 370                ((pcomplete-test "--rcfile")
 371                 (pcomplete-here* (pcomplete-entries)))
 372                ((pcomplete-test "--timecheck")
 373                 (pcomplete-here*))))
 374           (if (pcomplete-match "^-" 0)
 375               (pcomplete-opt "v")
 376             (pcomplete-here
 377              (pcomplete-dirs-or-entries (if (eq mode 'test)
 378                                             "\\.tar\\'"
 379                                           "\\.spec\\'"))))))
 380        (t
 381         (error "You must select a mode: -q, -i, -U, --verify, etc"))))))
 382
 383 (provide 'pcmpl-rpm)
 384
 385 ;;; pcmpl-rpm.el ends here