code.delx.au - gnu-emacs/blob - lisp/pcmpl-rpm.el

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