lisp/pcmpl-rpm.el

   1 ;;; pcmpl-rpm.el --- functions for dealing with rpm completions
   2
   3 ;; Copyright (C) 1999-2017 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 <http://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 (nth 5 (file-attributes pcmpl-rpm-cache-stamp-file))))
  75              (and mtime (not (time-less-p pcmpl-rpm-cache-time mtime)))))
  76       pcmpl-rpm-packages
  77     (message "Getting list of installed rpms...")
  78     (setq pcmpl-rpm-cache-time (current-time)
  79           pcmpl-rpm-packages
  80           (split-string (apply 'pcomplete-process-result "rpm"
  81                                (append '("-q" "-a")
  82                                        (if (stringp pcmpl-rpm-query-options)
  83                                            (list pcmpl-rpm-query-options)
  84                                          pcmpl-rpm-query-options)))))
  85     (message "Getting list of installed rpms...done")
  86     pcmpl-rpm-packages))
  87
  88 ;; Should this use pcmpl-rpm-query-options?
  89 ;; I don't think it would speed it up at all (?).
  90 (defun pcmpl-rpm-all-query (flag)
  91   (message "Querying all packages with `%s'..." flag)
  92   (let ((pkgs (pcmpl-rpm-packages))
  93         (provs (list t)))
  94     (while pkgs
  95       (nconc provs (split-string
  96                     (pcomplete-process-result
  97                      "rpm" "-q" (car pkgs) flag)))
  98       (setq pkgs (cdr pkgs)))
  99     (pcomplete-uniqify-list (cdr provs))))
 100
 101 (defsubst pcmpl-rpm-files ()
 102   (pcomplete-dirs-or-entries "\\.rpm\\'"))
 103
 104 ;;;###autoload
 105 (defun pcomplete/rpm ()
 106   "Completion for the `rpm' command."
 107   ;; Originally taken from the output of `rpm --help' on a Red Hat 6.1 system.
 108   (let (mode)
 109     (while (<= pcomplete-index pcomplete-last)
 110       (unless mode
 111         (if (pcomplete-match "^--\\(.*\\)" 0)
 112             (pcomplete-here*
 113              '("--addsign"
 114                "--checksig"
 115                "--erase"
 116                "--help"
 117                "--initdb"
 118                "--install"
 119                "--pipe"
 120                "--querytags"
 121                "--rebuild"
 122                "--rebuilddb"
 123                "--recompile"
 124                "--resign"
 125                "--rmsource"
 126                "--setperms"
 127                "--setugids"
 128                "--upgrade"
 129                "--verify"
 130                "--version"))
 131           (pcomplete-opt "vqVyiUebtK")))
 132 ;     -b<stage> <spec>
 133 ;     -t<stage> <tarball>    - build package, where <stage> is one of:
 134 ;         p                - prep (unpack sources and apply patches)
 135 ;         l                - list check (do some cursory checks on %files)
 136 ;         c                - compile (prep and compile)
 137 ;         i                - install (prep, compile, install)
 138 ;         b                - binary package (prep, compile, install, package)
 139 ;         a                - bin/src package (prep, compile, install, package)
 140       (cond
 141        ((or (eq mode 'query)
 142             (pcomplete-match "-[^-]*q"))
 143         (setq mode 'query)
 144         (if (pcomplete-match "^--\\(.*\\)" 0)
 145             (progn
 146               (pcomplete-here*
 147                '("--changelog"
 148                  "--dbpath"
 149                  "--dump"
 150                  "--file"
 151                  "--ftpport"            ;nyi for the next four
 152                  "--ftpproxy"
 153                  "--httpport"
 154                  "--httpproxy"
 155                  "--provides"
 156                  "--queryformat"
 157                  "--rcfile"
 158                  "--requires"
 159                  "--root"
 160                  "--scripts"
 161                  "--triggeredby"
 162                  "--whatprovides"
 163                  "--whatrequires"))
 164               (cond
 165                ((pcomplete-test "--dbpath")
 166                 (pcomplete-here* (pcomplete-dirs)))
 167                ((pcomplete-test "--queryformat")
 168                 (pcomplete-here*))
 169                ((pcomplete-test "--rcfile")
 170                 (pcomplete-here* (pcomplete-entries)))
 171                ((pcomplete-test "--file")
 172                 (pcomplete-here* (pcomplete-entries)))
 173                ((pcomplete-test "--root")
 174                 (pcomplete-here* (pcomplete-dirs)))
 175                ((pcomplete-test "--scripts")
 176                 (if (pcomplete-match "^--\\(.*\\)" 0)
 177                     (pcomplete-here* '("--triggers"))))
 178                ((pcomplete-test "--triggeredby")
 179                 (pcomplete-here* (pcmpl-rpm-packages)))
 180                ((pcomplete-test "--whatprovides")
 181                 (pcomplete-here*
 182                  (pcmpl-rpm-all-query "--provides")))
 183                ((pcomplete-test "--whatrequires")
 184                 (pcomplete-here*
 185                  (pcmpl-rpm-all-query "--requires")))))
 186           (if (pcomplete-match "^-" 0)
 187               (pcomplete-opt "af.p(pcmpl-rpm-files)ilsdcvR")
 188             (if (pcomplete-test "-[^-]*p" 'first 1)
 189                 (pcomplete-here (pcmpl-rpm-files))
 190               (if (pcomplete-test "-[^-]*f" 'first 1)
 191                   (pcomplete-here* (pcomplete-entries))
 192                 (pcomplete-here (pcmpl-rpm-packages)))))))
 193        ((pcomplete-test "--pipe")
 194         (pcomplete-here* (funcall pcomplete-command-completion-function)))
 195        ((pcomplete-test "--rmsource")
 196         (pcomplete-here* (pcomplete-entries))
 197         (throw 'pcomplete-completions nil))
 198        ((pcomplete-match "\\`--re\\(build\\|compile\\)\\'")
 199         (pcomplete-here (pcmpl-rpm-files))
 200         (throw 'pcomplete-completions nil))
 201        ((pcomplete-match "\\`--\\(resign\\|addsign\\)\\'")
 202         (while (pcomplete-here (pcmpl-rpm-files))))
 203        ((or (eq mode 'checksig)
 204             (pcomplete-test "--checksig"))
 205         (setq mode 'checksig)
 206         (if (pcomplete-match "^--\\(.*\\)" 0)
 207             (progn
 208               (pcomplete-here*
 209                '("--nopgp"
 210                  "--nogpg"
 211                  "--nomd5"
 212                  "--rcfile"))
 213               (cond
 214                ((pcomplete-test "--rcfile")
 215                 (pcomplete-here* (pcomplete-entries)))))
 216           (if (pcomplete-match "^-" 0)
 217               (pcomplete-opt "v")
 218             (pcomplete-here (pcmpl-rpm-files)))))
 219        ((or (eq mode 'rebuilddb)
 220             (pcomplete-test "--rebuilddb"))
 221         (setq mode 'rebuilddb)
 222         (if (pcomplete-match "^--\\(.*\\)" 0)
 223             (progn
 224               (pcomplete-here*
 225                '("--dbpath"
 226                  "--root"
 227                  "--rcfile"))
 228               (cond
 229                ((pcomplete-test "--dbpath")
 230                 (pcomplete-here* (pcomplete-dirs)))
 231                ((pcomplete-test "--root")
 232                 (pcomplete-here* (pcomplete-dirs)))
 233                ((pcomplete-test "--rcfile")
 234                 (pcomplete-here* (pcomplete-entries)))))
 235           (if (pcomplete-match "^-" 0)
 236               (pcomplete-opt "v")
 237             (pcomplete-here))))
 238        ((memq mode '(install upgrade))
 239         (if (pcomplete-match "^--\\(.*\\)" 0)
 240             (progn
 241               (pcomplete-here*
 242                (append
 243                 '("--allfiles"
 244                   "--badreloc"
 245                   "--dbpath"
 246                   "--excludedocs"
 247                   "--excludepath"
 248                   "--force"
 249                   "--hash"
 250                   "--ignorearch"
 251                   "--ignoreos"
 252                   "--ignoresize"
 253                   "--includedocs"
 254                   "--justdb"
 255                   "--nodeps"
 256                   "--noorder"
 257                   "--noscripts"
 258                   "--notriggers")
 259                 (if (eq mode 'upgrade)
 260                     '("--oldpackage"))
 261                 '("--percent"
 262                   "--prefix"
 263                   "--rcfile"
 264                   "--relocate"
 265                   "--replacefiles"
 266                   "--replacepkgs"
 267                   "--root")))
 268               (cond
 269                ((pcomplete-test "--dbpath")
 270                 (pcomplete-here* (pcomplete-dirs)))
 271                ((pcomplete-test "--relocate")
 272                 (pcomplete-here*))
 273                ((pcomplete-test "--rcfile")
 274                 (pcomplete-here* (pcomplete-entries)))
 275                ((pcomplete-test "--excludepath")
 276                 (pcomplete-here* (pcomplete-entries)))
 277                ((pcomplete-test "--root")
 278                 (pcomplete-here* (pcomplete-dirs)))
 279                ((pcomplete-test "--prefix")
 280                 (pcomplete-here* (pcomplete-dirs)))))
 281           (if (pcomplete-match "^-" 0)
 282               (pcomplete-opt "vh")
 283             (pcomplete-here (pcmpl-rpm-files)))))
 284        ((or (pcomplete-test "--install")
 285             (pcomplete-match "-[^-]*i"))
 286         (setq mode 'install))
 287        ((or (pcomplete-test "--upgrade")
 288             (pcomplete-match "-[^-]*U"))
 289         (setq mode 'upgrade))
 290        ((or (eq mode 'erase)
 291             (pcomplete-test "--erase")
 292             (pcomplete-match "-[^-]*e"))
 293         (setq mode 'erase)
 294         (if (pcomplete-match "^--\\(.*\\)" 0)
 295             (progn
 296               (pcomplete-here*
 297                '("--allmatches"
 298                  "--dbpath"
 299                  "--justdb"
 300                  "--nodeps"
 301                  "--noorder"
 302                  "--noscripts"
 303                  "--notriggers"
 304                  "--rcfile"
 305                  "--root"))
 306               (cond
 307                ((pcomplete-test "--dbpath")
 308                 (pcomplete-here* (pcomplete-dirs)))
 309                ((pcomplete-test "--rcfile")
 310                 (pcomplete-here* (pcomplete-entries)))
 311                ((pcomplete-test "--root")
 312                 (pcomplete-here* (pcomplete-dirs)))))
 313           (if (pcomplete-match "^-" 0)
 314               (pcomplete-opt "v")
 315             (pcomplete-here (pcmpl-rpm-packages)))))
 316        ((or (eq mode 'verify)
 317             (pcomplete-test "--verify"))
 318         (setq mode 'verify)
 319         (if (pcomplete-match "^--\\(.*\\)" 0)
 320             (progn
 321               (pcomplete-here*
 322                '("--dbpath"
 323                  "--nodeps"
 324                  "--nofiles"
 325                  "--nomd5"
 326                  "--rcfile"
 327                  "--root"
 328                  "--triggeredby"
 329                  "--whatprovides"
 330                  "--whatrequires"))
 331               (cond
 332                ((pcomplete-test "--dbpath")
 333                 (pcomplete-here* (pcomplete-dirs)))
 334                ((pcomplete-test "--rcfile")
 335                 (pcomplete-here* (pcomplete-entries)))
 336                ((pcomplete-test "--root")
 337                 (pcomplete-here* (pcomplete-dirs)))
 338                ((pcomplete-test "--triggeredby")
 339                 (pcomplete-here* (pcmpl-rpm-packages)))
 340                ((pcomplete-test "--whatprovides")
 341                 (pcomplete-here*
 342                  (pcmpl-rpm-all-query "--provides")))
 343                ((pcomplete-test "--whatrequires")
 344                 (pcomplete-here*
 345                  (pcmpl-rpm-all-query "--requires")))))
 346           (if (pcomplete-match "^-" 0)
 347               (pcomplete-opt "af.p(pcmpl-rpm-files)v")
 348             (pcomplete-here (pcmpl-rpm-packages)))))
 349        ((or (memq mode '(build test))
 350             (pcomplete-match "\\`-[bt]"))
 351         (setq mode (if (pcomplete-match "\\`-b")
 352                        'build
 353                      'test))
 354         (if (pcomplete-match "^--\\(.*\\)" 0)
 355             (progn
 356               (pcomplete-here*
 357                '("--buildroot"
 358                  "--clean"
 359                  "--nobuild"
 360                  "--rcfile"
 361                  "--rmsource"
 362                  "--short-circuit"
 363                  "--sign"
 364                  "--target"
 365                  "--timecheck"))
 366               (cond
 367                ((pcomplete-test "--buildroot")
 368                 (pcomplete-here* (pcomplete-dirs)))
 369                ((pcomplete-test "--rcfile")
 370                 (pcomplete-here* (pcomplete-entries)))
 371                ((pcomplete-test "--timecheck")
 372                 (pcomplete-here*))))
 373           (if (pcomplete-match "^-" 0)
 374               (pcomplete-opt "v")
 375             (pcomplete-here
 376              (pcomplete-dirs-or-entries (if (eq mode 'test)
 377                                             "\\.tar\\'"
 378                                           "\\.spec\\'"))))))
 379        (t
 380         (error "You must select a mode: -q, -i, -U, --verify, etc"))))))
 381
 382 (provide 'pcmpl-rpm)
 383
 384 ;;; pcmpl-rpm.el ends here