lisp/pcmpl-gnu.el

   1 ;;; pcmpl-gnu.el --- completions for GNU project tools -*- lexical-binding: t -*-
   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 ;;; Code:
  25
  26 (provide 'pcmpl-gnu)
  27
  28 (require 'pcomplete)
  29 (require 'pcmpl-unix)
  30
  31 (defgroup pcmpl-gnu nil
  32   "Completions for GNU project tools."
  33   :group 'pcomplete)
  34
  35 ;; User Variables:
  36
  37 (defcustom pcmpl-gnu-makefile-regexps
  38   '("\\`GNUmakefile" "\\`[Mm]akefile" "\\.ma?k\\'")
  39   "A list of regexps that will match Makefile names."
  40   :type '(repeat regexp)
  41   :group 'pcmpl-gnu)
  42
  43 ;; Functions:
  44
  45 ;;;###autoload
  46 (defun pcomplete/gzip ()
  47   "Completion for `gzip'."
  48   (let ((pcomplete-help "(gzip)"))
  49     (pcomplete-opt "cdfhlLnNqrStvV123456789")
  50     (while (pcomplete-here
  51             (pcmpl-gnu-zipped-files
  52              (catch 'has-d-flag
  53                (let ((args pcomplete-args))
  54                  (while args
  55                    (if (string-match "\\`-.*[dt]" (car args))
  56                        (throw 'has-d-flag t))
  57                    (setq args (cdr args))))))))))
  58
  59 (defun pcmpl-gnu-zipped-files (unzip-p)
  60   "Find all zipped or unzipped files: the inverse of UNZIP-P."
  61   (pcomplete-entries
  62    nil
  63    (function
  64     (lambda (entry)
  65       (when (and (file-readable-p entry)
  66                  (file-regular-p entry))
  67         (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
  68                                     entry)))
  69           (or (and unzip-p zipped)
  70               (and (not unzip-p) (not zipped)))))))))
  71
  72 ;;;###autoload
  73 (defun pcomplete/bzip2 ()
  74   "Completion for `bzip2'."
  75   (pcomplete-opt "hdzkftcqvLVs123456789")
  76   (while (pcomplete-here
  77           (pcmpl-gnu-bzipped-files
  78            (catch 'has-d-flag
  79              (let ((args pcomplete-args))
  80                (while args
  81                  (if (string-match "\\`-.*[dt]" (car args))
  82                      (throw 'has-d-flag t))
  83                  (setq args (cdr args)))))))))
  84
  85 (defun pcmpl-gnu-bzipped-files (unzip-p)
  86   "Find all zipped or unzipped files: the inverse of UNZIP-P."
  87   (pcomplete-entries
  88    nil
  89    (function
  90     (lambda (entry)
  91       (when (and (file-readable-p entry)
  92                  (file-regular-p entry))
  93         (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
  94           (or (and unzip-p zipped)
  95               (and (not unzip-p) (not zipped)))))))))
  96
  97 ;;;###autoload
  98 (defun pcomplete/make ()
  99   "Completion for GNU `make'."
 100   (let ((pcomplete-help "(make)Top"))
 101     (pcomplete-opt "bmC/def(pcmpl-gnu-makefile-names)hiI/j?kl?no.pqrsStvwW.")
 102     (while (pcomplete-here (completion-table-in-turn
 103                             (pcmpl-gnu-make-rule-names)
 104                             (pcomplete-entries))
 105                            nil 'identity))))
 106
 107 (defun pcmpl-gnu-makefile-names ()
 108   "Return a list of possible makefile names."
 109   (pcomplete-entries (mapconcat 'identity pcmpl-gnu-makefile-regexps "\\|")))
 110
 111 (defun pcmpl-gnu-make-rule-names ()
 112   "Return a list of possible make rule names in MAKEFILE."
 113   (let* ((minus-f (member "-f" pcomplete-args))
 114          (makefile (or (cadr minus-f)
 115                        (cond
 116                         ((file-exists-p "GNUmakefile") "GNUmakefile")
 117                         ((file-exists-p "makefile") "makefile")
 118                         (t "Makefile"))))
 119          rules)
 120     (if (not (file-readable-p makefile))
 121         (unless minus-f (list "-f"))
 122       (with-temp-buffer
 123         (ignore-errors                  ;Could be a directory or something.
 124           (insert-file-contents makefile))
 125         (while (re-search-forward
 126                 (concat "^\\s-*\\([^\n#%.$][^:=\n]*\\)\\s-*:[^=]") nil t)
 127           (setq rules (append (split-string (match-string 1)) rules))))
 128       (pcomplete-uniqify-list rules))))
 129
 130 (defcustom pcmpl-gnu-tarfile-regexp
 131   "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
 132   "A regexp which matches any tar archive."
 133   :type 'regexp
 134   :group 'pcmpl-gnu)
 135
 136 ;; Only used in tar-mode buffers.
 137 (defvar tar-parse-info)
 138 (declare-function tar-header-name "tar-mode" t t)
 139
 140 (defmacro pcmpl-gnu-with-file-buffer (file &rest body)
 141   "Run BODY inside a buffer visiting FILE."
 142   (declare (debug t) (indent 1))
 143   (let ((exist (make-symbol "exist"))
 144         (filesym (make-symbol "file"))
 145         (buf (make-symbol "buf")))
 146     `(let* ((,filesym ,file)
 147             (,exist (find-buffer-visiting ,filesym))
 148             (,buf (or ,exist (find-file-noselect ,filesym))))
 149        (unwind-protect
 150            (with-current-buffer ,buf
 151              ,@body)
 152          (when (and (not ,exist) (buffer-live-p ,buf))
 153            (kill-buffer ,buf))))))
 154
 155 ;;;###autoload
 156 (defun pcomplete/tar ()
 157   "Completion for the GNU tar utility."
 158   ;; options that end in an equal sign will want further completion...
 159   (let (saw-option complete-within)
 160     (let ((pcomplete-suffix-list (cons ?= pcomplete-suffix-list)))
 161       (while (pcomplete-match "^-" 0)
 162         (setq saw-option t)
 163         (if (pcomplete-match "^--" 0)
 164             (if (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0)
 165                 ;; FIXME: Extract this list from "tar --help".
 166                 (pcomplete-here*
 167                  '("--absolute-names"
 168                    "--after-date="
 169                    "--append"
 170                    "--atime-preserve"
 171                    "--backup"
 172                    "--block-number"
 173                    "--blocking-factor="
 174                    "--catenate"
 175                    "--checkpoint"
 176                    "--compare"
 177                    "--compress"
 178                    "--concatenate"
 179                    "--confirmation"
 180                    "--create"
 181                    "--delete"
 182                    "--dereference"
 183                    "--diff"
 184                    "--directory="
 185                    "--exclude="
 186                    "--exclude-from="
 187                    "--extract"
 188                    "--file="
 189                    "--files-from="
 190                    "--force-local"
 191                    "--get"
 192                    "--group="
 193                    "--gzip"
 194                    "--help"
 195                    "--ignore-failed-read"
 196                    "--ignore-zeros"
 197                    "--incremental"
 198                    "--info-script="
 199                    "--interactive"
 200                    "--keep-old-files"
 201                    "--label="
 202                    "--list"
 203                    "--listed-incremental"
 204                    "--mode="
 205                    "--modification-time"
 206                    "--multi-volume"
 207                    "--new-volume-script="
 208                    "--newer="
 209                    "--newer-mtime"
 210                    "--no-recursion"
 211                    "--null"
 212                    "--numeric-owner"
 213                    "--old-archive"
 214                    "--one-file-system"
 215                    "--owner="
 216                    "--portability"
 217                    "--posix"
 218                    "--preserve"
 219                    "--preserve-order"
 220                    "--preserve-permissions"
 221                    "--read-full-records"
 222                    "--record-size="
 223                    "--recursive-unlink"
 224                    "--remove-files"
 225                    "--rsh-command="
 226                    "--same-order"
 227                    "--same-owner"
 228                    "--same-permissions"
 229                    "--sparse"
 230                    "--starting-file="
 231                    "--suffix="
 232                    "--tape-length="
 233                    "--to-stdout"
 234                    "--totals"
 235                    "--uncompress"
 236                    "--ungzip"
 237                    "--unlink-first"
 238                    "--update"
 239                    "--use-compress-program="
 240                    "--verbose"
 241                    "--verify"
 242                    "--version"
 243                    "--volno-file=")))
 244           (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz"))
 245         (cond
 246          ((pcomplete-match "\\`-\\'" 0)
 247           (pcomplete-here*))
 248          ((pcomplete-match "\\`--after-date=" 0)
 249           (pcomplete-here*))
 250          ((pcomplete-match "\\`--backup=" 0)
 251           (pcomplete-here*))
 252          ((pcomplete-match "\\`--blocking-factor=" 0)
 253           (pcomplete-here*))
 254          ((pcomplete-match "\\`--directory=\\(.*\\)" 0)
 255           (pcomplete-here* (pcomplete-dirs)
 256                            (pcomplete-match-string 1 0)))
 257          ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0)
 258           (pcomplete-here* (pcomplete-entries)
 259                            (pcomplete-match-string 1 0)))
 260          ((pcomplete-match "\\`--exclude=" 0)
 261           (pcomplete-here*))
 262          ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0)
 263           (setq complete-within t))
 264          ((pcomplete-match "\\`--file=\\(.*\\)" 0)
 265           (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp)
 266                            (pcomplete-match-string 1 0)))
 267          ((pcomplete-match "\\`--files-from=\\(.*\\)" 0)
 268           (pcomplete-here* (pcomplete-entries)
 269                            (pcomplete-match-string 1 0)))
 270          ((pcomplete-match "\\`--group=\\(.*\\)" 0)
 271           (pcomplete-here* (pcmpl-unix-group-names)
 272                            (pcomplete-match-string 1 0)))
 273          ((pcomplete-match "\\`--info-script=\\(.*\\)" 0)
 274           (pcomplete-here* (pcomplete-entries)
 275                            (pcomplete-match-string 1 0)))
 276          ((pcomplete-match "\\`--label=" 0)
 277           (pcomplete-here*))
 278          ((pcomplete-match "\\`--mode=" 0)
 279           (pcomplete-here*))
 280          ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0)
 281           (pcomplete-here* (pcomplete-entries)
 282                            (pcomplete-match-string 1 0)))
 283          ((pcomplete-match "\\`--newer=" 0)
 284           (pcomplete-here*))
 285          ((pcomplete-match "\\`--owner=\\(.*\\)" 0)
 286           (pcomplete-here* (pcmpl-unix-user-names)
 287                            (pcomplete-match-string 1 0)))
 288          ((pcomplete-match "\\`--record-size=" 0)
 289           (pcomplete-here*))
 290          ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0)
 291           (pcomplete-here* (funcall pcomplete-command-completion-function)
 292                            (pcomplete-match-string 1 0)))
 293          ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0)
 294           (pcomplete-here* (pcomplete-entries)
 295                            (pcomplete-match-string 1 0)))
 296          ((pcomplete-match "\\`--suffix=" 0)
 297           (pcomplete-here*))
 298          ((pcomplete-match "\\`--tape-length=" 0)
 299           (pcomplete-here*))
 300          ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0)
 301           (pcomplete-here* (funcall pcomplete-command-completion-function)
 302                            (pcomplete-match-string 1 0)))
 303          ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0)
 304           (pcomplete-here* (pcomplete-entries)
 305                            (pcomplete-match-string 1 0))))))
 306     (unless saw-option
 307       (pcomplete-here
 308        (mapcar 'char-to-string
 309                (string-to-list
 310                 "01234567ABCFGIKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")))
 311       (if (pcomplete-match "[xt]" 'first 1)
 312           (setq complete-within t)))
 313     (pcomplete-here (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp))
 314     (while (pcomplete-here
 315             (if (and complete-within
 316                      (let* ((fa (file-attributes (pcomplete-arg 1)))
 317                             (size (nth 7 fa)))
 318                        (and (numberp size)
 319                             (or (null large-file-warning-threshold)
 320                                 (< size large-file-warning-threshold)))))
 321                 (let ((file (pcomplete-arg 1)))
 322                   (completion-table-dynamic
 323                    (lambda (_string)
 324                      (pcmpl-gnu-with-file-buffer file
 325                        (mapcar #'tar-header-name tar-parse-info)))))
 326               (pcomplete-entries))
 327             nil 'identity))))
 328
 329 ;;;###autoload
 330 (defalias 'pcomplete/gdb 'pcomplete/xargs)
 331
 332 ;;; pcmpl-gnu.el ends here