lisp/pcmpl-gnu.el

   1 ;;; pcmpl-gnu.el --- completions for GNU project tools -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 1999-2014 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\\|xz\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
 132   "A regexp which matches any tar archive."
 133   :version "24.3"                       ; added xz
 134   :type 'regexp
 135   :group 'pcmpl-gnu)
 136
 137 ;; Only used in tar-mode buffers.
 138 (defvar tar-parse-info)
 139 (declare-function tar-header-name "tar-mode" t t)
 140
 141 (defmacro pcmpl-gnu-with-file-buffer (file &rest body)
 142   "Run BODY inside a buffer visiting FILE."
 143   (declare (debug t) (indent 1))
 144   (let ((exist (make-symbol "exist"))
 145         (filesym (make-symbol "file"))
 146         (buf (make-symbol "buf")))
 147     `(let* ((,filesym ,file)
 148             (,exist (find-buffer-visiting ,filesym))
 149             (,buf (or ,exist (find-file-noselect ,filesym))))
 150        (unwind-protect
 151            (with-current-buffer ,buf
 152              ,@body)
 153          (when (and (not ,exist) (buffer-live-p ,buf))
 154            (kill-buffer ,buf))))))
 155
 156 ;;;###autoload
 157 (defun pcomplete/tar ()
 158   "Completion for the GNU tar utility."
 159   ;; options that end in an equal sign will want further completion...
 160   (let (saw-option complete-within)
 161     (let ((pcomplete-suffix-list (if (boundp 'pcomplete-suffix-list)
 162                                      (cons ?= pcomplete-suffix-list))))
 163       (while (pcomplete-match "^-" 0)
 164         (setq saw-option t)
 165         (if (pcomplete-match "^--" 0)
 166             (if (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0)
 167                 ;; FIXME: Extract this list from "tar --help".
 168                 (pcomplete-here*
 169                  '("--absolute-names"
 170                    "--after-date="
 171                    "--append"
 172                    "--atime-preserve"
 173                    "--backup"
 174                    "--block-number"
 175                    "--blocking-factor="
 176                    "--catenate"
 177                    "--checkpoint"
 178                    "--compare"
 179                    "--compress"
 180                    "--concatenate"
 181                    "--confirmation"
 182                    "--create"
 183                    "--delete"
 184                    "--dereference"
 185                    "--diff"
 186                    "--directory="
 187                    "--exclude="
 188                    "--exclude-from="
 189                    "--extract"
 190                    "--file="
 191                    "--files-from="
 192                    "--force-local"
 193                    "--get"
 194                    "--group="
 195                    "--gzip"
 196                    "--help"
 197                    "--ignore-failed-read"
 198                    "--ignore-zeros"
 199                    "--incremental"
 200                    "--info-script="
 201                    "--interactive"
 202                    "--keep-old-files"
 203                    "--label="
 204                    "--list"
 205                    "--listed-incremental"
 206                    "--mode="
 207                    "--modification-time"
 208                    "--multi-volume"
 209                    "--new-volume-script="
 210                    "--newer="
 211                    "--newer-mtime"
 212                    "--no-recursion"
 213                    "--null"
 214                    "--numeric-owner"
 215                    "--old-archive"
 216                    "--one-file-system"
 217                    "--owner="
 218                    "--portability"
 219                    "--posix"
 220                    "--preserve"
 221                    "--preserve-order"
 222                    "--preserve-permissions"
 223                    "--read-full-records"
 224                    "--record-size="
 225                    "--recursive-unlink"
 226                    "--remove-files"
 227                    "--rsh-command="
 228                    "--same-order"
 229                    "--same-owner"
 230                    "--same-permissions"
 231                    "--sparse"
 232                    "--starting-file="
 233                    "--suffix="
 234                    "--tape-length="
 235                    "--to-stdout"
 236                    "--totals"
 237                    "--uncompress"
 238                    "--ungzip"
 239                    "--unlink-first"
 240                    "--update"
 241                    "--use-compress-program="
 242                    "--verbose"
 243                    "--verify"
 244                    "--version"
 245                    "--volno-file=")))
 246           (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz"))
 247         (cond
 248          ((pcomplete-match "\\`-\\'" 0)
 249           (pcomplete-here*))
 250          ((pcomplete-match "\\`--after-date=" 0)
 251           (pcomplete-here*))
 252          ((pcomplete-match "\\`--backup=" 0)
 253           (pcomplete-here*))
 254          ((pcomplete-match "\\`--blocking-factor=" 0)
 255           (pcomplete-here*))
 256          ((pcomplete-match "\\`--directory=\\(.*\\)" 0)
 257           (pcomplete-here* (pcomplete-dirs)
 258                            (pcomplete-match-string 1 0)))
 259          ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0)
 260           (pcomplete-here* (pcomplete-entries)
 261                            (pcomplete-match-string 1 0)))
 262          ((pcomplete-match "\\`--exclude=" 0)
 263           (pcomplete-here*))
 264          ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0)
 265           (setq complete-within t))
 266          ((pcomplete-match "\\`--file=\\(.*\\)" 0)
 267           (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp)
 268                            (pcomplete-match-string 1 0)))
 269          ((pcomplete-match "\\`--files-from=\\(.*\\)" 0)
 270           (pcomplete-here* (pcomplete-entries)
 271                            (pcomplete-match-string 1 0)))
 272          ((pcomplete-match "\\`--group=\\(.*\\)" 0)
 273           (pcomplete-here* (pcmpl-unix-group-names)
 274                            (pcomplete-match-string 1 0)))
 275          ((pcomplete-match "\\`--info-script=\\(.*\\)" 0)
 276           (pcomplete-here* (pcomplete-entries)
 277                            (pcomplete-match-string 1 0)))
 278          ((pcomplete-match "\\`--label=" 0)
 279           (pcomplete-here*))
 280          ((pcomplete-match "\\`--mode=" 0)
 281           (pcomplete-here*))
 282          ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0)
 283           (pcomplete-here* (pcomplete-entries)
 284                            (pcomplete-match-string 1 0)))
 285          ((pcomplete-match "\\`--newer=" 0)
 286           (pcomplete-here*))
 287          ((pcomplete-match "\\`--owner=\\(.*\\)" 0)
 288           (pcomplete-here* (pcmpl-unix-user-names)
 289                            (pcomplete-match-string 1 0)))
 290          ((pcomplete-match "\\`--record-size=" 0)
 291           (pcomplete-here*))
 292          ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0)
 293           (pcomplete-here* (funcall pcomplete-command-completion-function)
 294                            (pcomplete-match-string 1 0)))
 295          ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0)
 296           (pcomplete-here* (pcomplete-entries)
 297                            (pcomplete-match-string 1 0)))
 298          ((pcomplete-match "\\`--suffix=" 0)
 299           (pcomplete-here*))
 300          ((pcomplete-match "\\`--tape-length=" 0)
 301           (pcomplete-here*))
 302          ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0)
 303           (pcomplete-here* (funcall pcomplete-command-completion-function)
 304                            (pcomplete-match-string 1 0)))
 305          ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0)
 306           (pcomplete-here* (pcomplete-entries)
 307                            (pcomplete-match-string 1 0))))))
 308     (unless saw-option
 309       (pcomplete-here
 310        (mapcar 'char-to-string
 311                (string-to-list
 312                 "01234567ABCFGIKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")))
 313       (if (pcomplete-match "[xt]" 'first 1)
 314           (setq complete-within t)))
 315     (pcomplete-here (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp))
 316     (while (pcomplete-here
 317             (if (and complete-within
 318                      (let* ((fa (file-attributes (pcomplete-arg 1)))
 319                             (size (nth 7 fa)))
 320                        (and (numberp size)
 321                             (or (null large-file-warning-threshold)
 322                                 (< size large-file-warning-threshold)))))
 323                 (let ((file (pcomplete-arg 1)))
 324                   (completion-table-dynamic
 325                    (lambda (_string)
 326                      (pcmpl-gnu-with-file-buffer file
 327                        (mapcar #'tar-header-name tar-parse-info)))))
 328               (pcomplete-entries))
 329             nil 'identity))))
 330
 331 ;;;###autoload
 332 (defalias 'pcomplete/gdb 'pcomplete/xargs)
 333
 334 ;;; pcmpl-gnu.el ends here