procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

pcomplete: Generate completions from --help messages

Browse source 
* lisp/pcomplete.el (pcomplete-from-help): New function (and hash
table) to get pcomplete candidates from help messages.
(pcomplete-here-using-help): Helper function to define pcomplete for
simple commands
(pcomplete-completions-at-point): Provide annotation-function and
company-docsig properties.
* lisp/pcmpl-git.el: New file, provides pcomplete for Git.
* lisp/pcmpl-gnu.el: Add pcomplete for awk, gpg and gdb, emacs and
emacsclient.
* lisp/pcmpl-linux.el: Add pcomplete for systemctl and journalctl.
* lisp/pcmpl-rpm.el: Add pcomplete for dnf.
* lisp/pcmpl-unix.el: Add pcomplete for sudo and most commands found
in GNU Coreutils.
* lisp/pcmpl-x.el: Add pcomplete for tex, pdftex, latex, pdflatex,
rigrep and rclone.
* test/lisp/pcomplete-tests.el (pcomplete-test-parse-gpg-help,
pcomplete-test-parse-git-help): Tests for the new functions.
This commit is contained in:
Augusto Stoffel 2022-09-08 11:09:42 +02:00 • committed by Lars Ingebrigtsen
parent 05971d2b8d
commit a994126968
8 changed files with 1004 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

110
lisp/pcmpl-git.el Normal file
View file

@ -0,0 +1,110 @@
;;; pcmpl-git.el --- Completions for Git -*- lexical-binding: t -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
;; Package: pcomplete
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides completion rules for the Git program.
;;; Code:
(require 'pcomplete)
(require 'vc-git)
(defun pcmpl-git--expand-flags (args)
"In the list of ARGS, expand arguments of the form --[no-]flag."
(mapcan (lambda (arg) (if (string-search "[no-]" arg)
(list (string-replace "[no-]" "" arg)
(string-replace "[no-]" "no-" arg))
(list arg)))
args))
(defun pcmpl-git--tracked-file-predicate (&rest args)
"Return a predicate function determining the Git status of a file.
Files listed by `git ls-files ARGS' satisfy the predicate."
(when-let ((files (mapcar #'expand-file-name
(ignore-errors
(apply #'process-lines
vc-git-program "ls-files" args)))))
(lambda (file)
(setq file (expand-file-name file))
(if (string-suffix-p "/" file)
(seq-some (lambda (f) (string-prefix-p file f))
files)
(member file files)))))
(defun pcmpl-git--remote-refs (remote)
"List the locally known Git revisions from REMOTE."
(delq nil
(mapcar
(let ((re (concat "\\`" (regexp-quote remote) "/\\(.*\\)")))
(lambda (s) (when (string-match re s) (match-string 1 s))))
(vc-git-revision-table nil))))
;;;###autoload
(defun pcomplete/git ()
"Completion for the `git' command."
(let ((subcommands (pcomplete-from-help `(,vc-git-program "help" "-a")
:margin "^\\( +\\)[a-z]"
:argument "[[:alnum:]-]+")))
(while (not (member (pcomplete-arg 1) subcommands))
(if (string-prefix-p "-" (pcomplete-arg))
(pcomplete-here (pcomplete-from-help `(,vc-git-program "help")
:margin "\\(\\[\\)-"
:separator " | "
:description "\\`"))
(pcomplete-here (completion-table-merge
subcommands
(when (string-prefix-p "-" (pcomplete-arg 1))
(pcomplete-entries))))))
(let ((subcmd (pcomplete-arg 1)))
(while (pcase subcmd
((guard (string-prefix-p "-" (pcomplete-arg)))
(pcomplete-here
(pcmpl-git--expand-flags
(pcomplete-from-help `(,vc-git-program "help" ,subcmd)
:argument
"-+\\(?:\\[no-\\]\\)?[a-z-]+=?"))))
;; Complete modified tracked files
((or "add" "commit" "restore")
(pcomplete-here
(pcomplete-entries
nil (pcmpl-git--tracked-file-predicate "-m"))))
;; Complete all tracked files
((or "mv" "rm" "grep" "status")
(pcomplete-here
(pcomplete-entries nil (pcmpl-git--tracked-file-predicate))))
;; Complete revisions
((or "branch" "merge" "rebase" "switch")
(pcomplete-here (vc-git-revision-table nil)))
;; Complete revisions and tracked files
;; TODO: diff and log accept revision ranges
((or "checkout" "reset" "show" "diff" "log")
(pcomplete-here
(completion-table-in-turn
(vc-git-revision-table nil)
(pcomplete-entries nil (pcmpl-git--tracked-file-predicate)))))
;; Complete remotes and their revisions
((or "fetch" "pull" "push")
(pcomplete-here (process-lines vc-git-program "remote"))
(pcomplete-here (pcmpl-git--remote-refs (pcomplete-arg 1)))))))))
(provide 'pcmpl-git)
;;; pcmpl-git.el ends here

36
lisp/pcmpl-gnu.el
View file

@ -394,6 +394,40 @@ Return the new list."
(while (pcomplete-here (pcomplete-dirs) nil #'identity))))
;;;###autoload
(defalias 'pcomplete/gdb 'pcomplete/xargs)
(defun pcomplete/awk ()
"Completion for the `awk' command."
(pcomplete-here-using-help "awk --help"
:margin "\t"
:separator " +"
:description "\0"
:metavar "[=a-z]+"))
;;;###autoload
(defun pcomplete/gpg ()
"Completion for the `gpg` command."
(pcomplete-here-using-help "gpg --help" :narrow-end "^ -se"))
;;;###autoload
(defun pcomplete/gdb ()
"Completion for the `gdb' command."
(while
(cond
((string= "--args" (pcomplete-arg 1))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
((string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "gdb --help")))
(t (pcomplete-here (pcomplete-entries))))))
;;;###autoload
(defun pcomplete/emacs ()
"Completion for the `emacs' command."
(pcomplete-here-using-help "emacs --help" :margin "^\\(\\)-"))
;;;###autoload
(defun pcomplete/emacsclient ()
"Completion for the `emacsclient' command."
(pcomplete-here-using-help "emacsclient --help" :margin "^\\(\\)-"))
;;; pcmpl-gnu.el ends here

68
lisp/pcmpl-linux.el
View file

@ -30,6 +30,7 @@
(provide 'pcmpl-linux)
(require 'pcomplete)
(eval-when-compile (require 'rx))
;; Functions:
@ -111,4 +112,71 @@ Test is done using `equal'."
(pcomplete-uniquify-list points)
(cons "swap" (pcmpl-linux-mounted-directories))))))
;;; systemd
(defun pcmpl-linux--systemd-units (&rest args)
"Run `systemd list-units ARGS' and return the output as a list."
(with-temp-buffer
(apply #'call-process
"systemctl" nil '(t nil) nil
"list-units" "--full" "--legend=no" "--plain" args)
(goto-char (point-min))
(let (result)
(while (re-search-forward (rx bol (group (+ (not space)))
(+ space) (+ (not space))
(+ space) (group (+ (not space)))
(+ space) (+ (not space))
(+ space) (group (* nonl)))
nil t)
(push (match-string 1) result)
(put-text-property 0 1 'pcomplete-annotation
(concat " " (match-string 2))
(car result))
(put-text-property 0 1 'pcomplete-description
(match-string 3)
(car result)))
(nreverse result))))
;;;###autoload
(defun pcomplete/systemctl ()
"Completion for the `systemctl' command."
(let ((subcmds (pcomplete-from-help
"systemctl --help"
:margin (rx bol " " (group) alpha)
:argument (rx (+ (any alpha ?-)))
:metavar (rx (group (+ " " (>= 2 (any upper "[]|."))))))))
(while (not (member (pcomplete-arg 1) subcmds))
(if (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "systemctl --help"
:metavar "[^ ]+"
:separator " \\(\\)-"))
(pcomplete-here subcmds)))
(let ((subcmd (pcomplete-arg 1))
(context (if (member "--user" pcomplete-args) "--user" "--system")))
(while (pcase subcmd
((guard (string-prefix-p "-" (pcomplete-arg 0)))
(pcomplete-here
(pcomplete-from-help "systemctl --help")))
;; TODO: suggest only relevant units to each subcommand
("start"
(pcomplete-here
(pcmpl-linux--systemd-units context "--state" "inactive,failed")))
((or "restart" "stop")
(pcomplete-here
(pcmpl-linux--systemd-units context "--state" "active")))
(_ (pcomplete-here
(completion-table-in-turn
(pcmpl-linux--systemd-units context "--all")
(pcomplete-entries)))))))))
;;;###autoload
(defun pcomplete/journalctl ()
"Completion for the `journalctl' command."
(while (if (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "journalctl --help"
:metavar "[^ ]+"
:separator " \\(\\)-"))
(pcomplete-here (mapcar (lambda (s) (concat s "="))
(process-lines "journalctl" "--fields"))))))
;;; pcmpl-linux.el ends here

43
lisp/pcmpl-rpm.el
View file

@ -21,7 +21,8 @@
;;; Commentary:
;; These functions provide completion rules for the `rpm' command.
;; These functions provide completion rules for the `rpm' command and
;; related tools.
;;; Code:
@ -378,6 +379,46 @@
(t
(error "You must select a mode: -q, -i, -U, --verify, etc"))))))
;;; DNF
(defvar pcmpl-rpm-dnf-cache-file "/var/cache/dnf/packages.db"
"Location of the DNF cache.")
(defun pcmpl-rpm--dnf-packages (status)
(when (and (file-exists-p pcmpl-rpm-dnf-cache-file)
(executable-find "sqlite3"))
(with-temp-message
"Getting list of packages..."
(process-lines "sqlite3" "-batch" "-init" "/dev/null"
pcmpl-rpm-dnf-cache-file
(pcase-exhaustive status
('available "select pkg from available")
('installed "select pkg from installed")
('not-installed "\
select pkg from available where pkg not in (select pkg from installed)"))))))
;;;###autoload
(defun pcomplete/dnf ()
"Completion for the `dnf' command."
(let ((subcmds (pcomplete-from-help "dnf help"
:margin "^\\(\\)[a-z-]+ "
:argument "[a-z-]+")))
(while (not (member (pcomplete-arg 1) subcmds))
(pcomplete-here (completion-table-merge
subcmds
(pcomplete-from-help "dnf help"))))
(let ((subcmd (pcomplete-arg 1)))
(while (pcase subcmd
((guard (pcomplete-match "\\`-" 0))
(pcomplete-here
(pcomplete-from-help `("dnf" "help" ,subcmd))))
((or "downgrade" "reinstall" "remove")
(pcomplete-here (pcmpl-rpm--dnf-packages 'installed)))
((or "install" "mark" "reinstall" "upgrade")
(pcomplete-here (pcmpl-rpm--dnf-packages 'not-installed)))
((or "builddep" "changelog" "info" "list" "repoquery" "updateinfo")
(pcomplete-here (pcmpl-rpm--dnf-packages 'available))))))))
(provide 'pcmpl-rpm)
;;; pcmpl-rpm.el ends here

490
lisp/pcmpl-unix.el
View file

@ -25,7 +25,7 @@
(require 'pcomplete)
;; User Variables:
;;; User Variables
(defcustom pcmpl-unix-group-file "/etc/group"
"If non-nil, a string naming the group file on your system."
@ -56,7 +56,7 @@ being via `pcmpl-ssh-known-hosts-file'."
:group 'pcmpl-unix
:version "24.1")
;; Functions:
;;; Shell builtins and core utilities
;;;###autoload
(defun pcomplete/cd ()
@ -69,34 +69,38 @@ being via `pcmpl-ssh-known-hosts-file'."
;;;###autoload
(defun pcomplete/rmdir ()
"Completion for `rmdir'."
(while (pcomplete-here (pcomplete-dirs))))
(while (if (string-prefix-p "-" (pcomplete-arg))
(pcomplete-here (pcomplete-from-help "rmdir --help"))
(pcomplete-here (pcomplete-dirs)))))
;;;###autoload
(defun pcomplete/rm ()
"Completion for `rm'."
(let ((pcomplete-help "(fileutils)rm invocation"))
(pcomplete-opt "dfirRv")
(while (pcomplete-here (pcomplete-all-entries) nil
#'expand-file-name))))
"Completion for the `rm' command."
(pcomplete-here-using-help "rm --help"))
;;;###autoload
(defun pcomplete/xargs ()
"Completion for `xargs'."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (funcall pcomplete-default-completion-function)))
(pcomplete-here (pcomplete-from-help "xargs --help"))
(when (pcomplete-match "\\`-[adEIiLnPs]\\'") (pcomplete-here)))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;; FIXME: Add completion of sudo-specific arguments.
(defalias 'pcomplete/sudo #'pcomplete/xargs)
;;;###autoload
(defalias 'pcomplete/time 'pcomplete/xargs)
(defun pcomplete/time ()
"Completion for the `time' command."
(pcomplete-opt "p")
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/which ()
"Completion for `which'."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "which --help")))
(while (pcomplete-here (funcall pcomplete-command-completion-function))))
(defun pcmpl-unix-read-passwd-file (file)
@ -128,25 +132,455 @@ documentation), this function returns nil."
(if pcmpl-unix-passwd-file
(pcmpl-unix-read-passwd-file pcmpl-unix-passwd-file)))
;;;###autoload
(defun pcomplete/cat ()
"Completion for the `cat' command."
(pcomplete-here-using-help "cat --help"))
;;;###autoload
(defun pcomplete/tac ()
"Completion for the `tac' command."
(pcomplete-here-using-help "tac --help"))
;;;###autoload
(defun pcomplete/nl ()
"Completion for the `nl' command."
(pcomplete-here-using-help "nl --help"))
;;;###autoload
(defun pcomplete/od ()
"Completion for the `od' command."
(pcomplete-here-using-help "od --help"))
;;;###autoload
(defun pcomplete/base32 ()
"Completion for the `base32' and `base64' commands."
(pcomplete-here-using-help "base32 --help"))
;;;###autoload
(defalias 'pcomplete/base64 'pcomplete/base32)
;;;###autoload
(defun pcomplete/basenc ()
"Completion for the `basenc' command."
(pcomplete-here-using-help "basenc --help"))
;;;###autoload
(defun pcomplete/fmt ()
"Completion for the `fmt' command."
(pcomplete-here-using-help "fmt --help"))
;;;###autoload
(defun pcomplete/pr ()
"Completion for the `pr' command."
(pcomplete-here-using-help "pr --help"))
;;;###autoload
(defun pcomplete/fold ()
"Completion for the `fold' command."
(pcomplete-here-using-help "fold --help"))
;;;###autoload
(defun pcomplete/head ()
"Completion for the `head' command."
(pcomplete-here-using-help "head --help"))
;;;###autoload
(defun pcomplete/tail ()
"Completion for the `tail' command."
(pcomplete-here-using-help "tail --help"))
;;;###autoload
(defun pcomplete/split ()
"Completion for the `split' command."
(pcomplete-here-using-help "split --help"))
;;;###autoload
(defun pcomplete/csplit ()
"Completion for the `csplit' command."
(pcomplete-here-using-help "csplit --help"))
;;;###autoload
(defun pcomplete/wc ()
"Completion for the `wc' command."
(pcomplete-here-using-help "wc --help"))
;;;###autoload
(defun pcomplete/sum ()
"Completion for the `sum' command."
(pcomplete-here-using-help "sum --help"))
;;;###autoload
(defun pcomplete/cksum ()
"Completion for the `cksum' command."
(pcomplete-here-using-help "cksum --help"))
;;;###autoload
(defun pcomplete/b2sum ()
"Completion for the `b2sum' command."
(pcomplete-here-using-help "b2sum --help"))
;;;###autoload
(defun pcomplete/md5sum ()
"Completion for checksum commands."
(pcomplete-here-using-help "md5sum --help"))
;;;###autoload(defalias 'pcomplete/sha1sum 'pcomplete/md5sum)
;;;###autoload(defalias 'pcomplete/sha224sum 'pcomplete/md5sum)
;;;###autoload(defalias 'pcomplete/sha256sum 'pcomplete/md5sum)
;;;###autoload(defalias 'pcomplete/sha384sum 'pcomplete/md5sum)
;;;###autoload(defalias 'pcomplete/sha521sum 'pcomplete/md5sum)
;;;###autoload
(defun pcomplete/sort ()
"Completion for the `sort' command."
(pcomplete-here-using-help "sort --help"))
;;;###autoload
(defun pcomplete/shuf ()
"Completion for the `shuf' command."
(pcomplete-here-using-help "shuf --help"))
;;;###autoload
(defun pcomplete/uniq ()
"Completion for the `uniq' command."
(pcomplete-here-using-help "uniq --help"))
;;;###autoload
(defun pcomplete/comm ()
"Completion for the `comm' command."
(pcomplete-here-using-help "comm --help"))
;;;###autoload
(defun pcomplete/ptx ()
"Completion for the `ptx' command."
(pcomplete-here-using-help "ptx --help"))
;;;###autoload
(defun pcomplete/tsort ()
"Completion for the `tsort' command."
(pcomplete-here-using-help "tsort --help"))
;;;###autoload
(defun pcomplete/cut ()
"Completion for the `cut' command."
(pcomplete-here-using-help "cut --help"))
;;;###autoload
(defun pcomplete/paste ()
"Completion for the `paste' command."
(pcomplete-here-using-help "paste --help"))
;;;###autoload
(defun pcomplete/join ()
"Completion for the `join' command."
(pcomplete-here-using-help "join --help"))
;;;###autoload
(defun pcomplete/tr ()
"Completion for the `tr' command."
(pcomplete-here-using-help "tr --help"))
;;;###autoload
(defun pcomplete/expand ()
"Completion for the `expand' command."
(pcomplete-here-using-help "expand --help"))
;;;###autoload
(defun pcomplete/unexpand ()
"Completion for the `unexpand' command."
(pcomplete-here-using-help "unexpand --help"))
;;;###autoload
(defun pcomplete/ls ()
"Completion for the `ls' command."
(pcomplete-here-using-help "ls --help"))
;;;###autoload(defalias 'pcomplete/dir 'pcomplete/ls)
;;;###autoload(defalias 'pcomplete/vdir 'pcomplete/ls)
;;;###autoload
(defun pcomplete/cp ()
"Completion for the `cp' command."
(pcomplete-here-using-help "cp --help"))
;;;###autoload
(defun pcomplete/dd ()
"Completion for the `dd' command."
(let ((operands (pcomplete-from-help "dd --help"
:argument "[a-z]+="
:narrow-start "\n\n"
:narrow-end "\n\n")))
(while
(cond ((pcomplete-match "\\`[io]f=\\(.*\\)" 0)
(pcomplete-here (pcomplete-entries)
(pcomplete-match-string 1 0)))
(t (pcomplete-here operands))))))
;;;###autoload
(defun pcomplete/install ()
"Completion for the `install' command."
(pcomplete-here-using-help "install --help"))
;;;###autoload
(defun pcomplete/mv ()
"Completion for the `mv' command."
(pcomplete-here-using-help "mv --help"))
;;;###autoload
(defun pcomplete/shred ()
"Completion for the `shred' command."
(pcomplete-here-using-help "shred --help"))
;;;###autoload
(defun pcomplete/ln ()
"Completion for the `ln' command."
(pcomplete-here-using-help "ln --help"))
;;;###autoload
(defun pcomplete/mkdir ()
"Completion for the `mkdir' command."
(pcomplete-here-using-help "mkdir --help"))
;;;###autoload
(defun pcomplete/mkfifo ()
"Completion for the `mkfifo' command."
(pcomplete-here-using-help "mkfifo --help"))
;;;###autoload
(defun pcomplete/mknod ()
"Completion for the `mknod' command."
(pcomplete-here-using-help "mknod --help"))
;;;###autoload
(defun pcomplete/readlink ()
"Completion for the `readlink' command."
(pcomplete-here-using-help "readlink --help"))
;;;###autoload
(defun pcomplete/chown ()
"Completion for the `chown' command."
(unless (pcomplete-match "\\`-")
(if (pcomplete-match "\\`[^.]*\\'" 0)
(pcomplete-here* (pcmpl-unix-user-names))
(if (pcomplete-match "\\.\\([^.]*\\)\\'" 0)
(pcomplete-here* (pcmpl-unix-group-names)
(pcomplete-match-string 1 0))
(pcomplete-here*))))
(while (pcomplete-match "\\`-" 0)
(pcomplete-here (pcomplete-from-help "chown --help")))
(if (pcomplete-match "\\`[^.]*\\'" 0)
(pcomplete-here* (pcmpl-unix-user-names))
(if (pcomplete-match "\\.\\([^.]*\\)\\'" 0)
(pcomplete-here* (pcmpl-unix-group-names)
(pcomplete-match-string 1 0))
(pcomplete-here*)))
(while (pcomplete-here (pcomplete-entries))))
;;;###autoload
(defun pcomplete/chgrp ()
"Completion for the `chgrp' command."
(unless (pcomplete-match "\\`-")
(pcomplete-here* (pcmpl-unix-group-names)))
(while (pcomplete-match "\\`-" 0)
(pcomplete-here (pcomplete-from-help "chgrp --help")))
(pcomplete-here* (pcmpl-unix-group-names))
(while (pcomplete-here (pcomplete-entries))))
;;;###autoload
(defun pcomplete/chmod ()
"Completion for the `chmod' command."
(pcomplete-here-using-help "chmod --help"))
;;;###autoload
(defun pcomplete/touch ()
"Completion for the `touch' command."
(pcomplete-here-using-help "touch --help"))
;;;###autoload
(defun pcomplete/df ()
"Completion for the `df' command."
(pcomplete-here-using-help "df --help"))
;;;###autoload
(defun pcomplete/du ()
"Completion for the `du' command."
(pcomplete-here-using-help "du --help"))
;;;###autoload
(defun pcomplete/stat ()
"Completion for the `stat' command."
(pcomplete-here-using-help "stat --help"))
;;;###autoload
(defun pcomplete/sync ()
"Completion for the `sync' command."
(pcomplete-here-using-help "sync --help"))
;;;###autoload
(defun pcomplete/truncate ()
"Completion for the `truncate' command."
(pcomplete-here-using-help "truncate --help"))
;;;###autoload
(defun pcomplete/echo ()
"Completion for the `echo' command."
(pcomplete-here-using-help '("echo" "--help")))
;;;###autoload
(defun pcomplete/test ()
"Completion for the `test' command."
(pcomplete-here-using-help '("[" "--help")
:margin "^ +\\([A-Z]+1 \\)?"))
;;;###autoload(defalias (intern "pcomplete/[") 'pcomplete/test)
;;;###autoload
(defun pcomplete/tee ()
"Completion for the `tee' command."
(pcomplete-here-using-help "tee --help"))
;;;###autoload
(defun pcomplete/basename ()
"Completion for the `basename' command."
(pcomplete-here-using-help "basename --help"))
;;;###autoload
(defun pcomplete/dirname ()
"Completion for the `dirname' command."
(pcomplete-here-using-help "dirname --help"))
;;;###autoload
(defun pcomplete/pathchk ()
"Completion for the `pathchk' command."
(pcomplete-here-using-help "pathchk --help"))
;;;###autoload
(defun pcomplete/mktemp ()
"Completion for the `mktemp' command."
(pcomplete-here-using-help "mktemp --help"))
;;;###autoload
(defun pcomplete/realpath ()
"Completion for the `realpath' command."
(pcomplete-here-using-help "realpath --help"))
;;;###autoload
(defun pcomplete/id ()
"Completion for the `id' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "id --help")))
(while (pcomplete-here (pcmpl-unix-user-names))))
;;;###autoload
(defun pcomplete/groups ()
"Completion for the `groups' command."
(while (pcomplete-here (pcmpl-unix-user-names))))
;;;###autoload
(defun pcomplete/who ()
"Completion for the `who' command."
(pcomplete-here-using-help "who --help"))
;;;###autoload
(defun pcomplete/date ()
"Completion for the `date' command."
(pcomplete-here-using-help "date --help"))
;;;###autoload
(defun pcomplete/nproc ()
"Completion for the `nproc' command."
(pcomplete-here-using-help "nproc --help"))
;;;###autoload
(defun pcomplete/uname ()
"Completion for the `uname' command."
(pcomplete-here-using-help "uname --help"))
;;;###autoload
(defun pcomplete/hostname ()
"Completion for the `hostname' command."
(pcomplete-here-using-help "hostname --help"))
;;;###autoload
(defun pcomplete/uptime ()
"Completion for the `uptime' command."
(pcomplete-here-using-help "uptime --help"))
;;;###autoload
(defun pcomplete/chcon ()
"Completion for the `chcon' command."
(pcomplete-here-using-help "chcon --help"))
;;;###autoload
(defun pcomplete/runcon ()
"Completion for the `runcon' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "runcon --help"))
(when (pcomplete-match "\\`-[turl]\\'" 0) (pcomplete-here)))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/chroot ()
"Completion for the `chroot' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "chroot --help")))
(pcomplete-here (pcomplete-dirs))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/env ()
"Completion for the `env' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "env --help"))
(when (pcomplete-match "\\`-[uCS]\\'") (pcomplete-here)))
(while (pcomplete-match "=" 0) (pcomplete-here)) ; FIXME: Complete env vars
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/nice ()
"Completion for the `nice' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "nice --help"))
(pcomplete-here))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/nohup ()
"Completion for the `nohup' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "nohup --help")))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/stdbuf ()
"Completion for the `stdbuf' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "stdbuf --help"))
(when (pcomplete-match "\\`-[ioe]\\'") (pcomplete-here)))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/timeout ()
"Completion for the `timeout' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "timeout --help"))
(when (pcomplete-match "\\`-[ks]\\'") (pcomplete-here)))
(pcomplete-here) ; eat DURATION argument
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/numfmt ()
"Completion for the `numfmt' command."
(pcomplete-here-using-help "numfmt --help"))
;;;###autoload
(defun pcomplete/seq ()
"Completion for the `seq' command."
(pcomplete-here-using-help "seq --help"))
;;; Network commands
;; ssh support by Phil Hagelberg.
;; https://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el
@ -239,6 +673,18 @@ Includes files as well as host names followed by a colon."
(pcomplete-opt "xl(pcmpl-unix-user-names)")
(pcmpl-unix-complete-hostname))
;;; Miscellaneous
;;;###autoload
(defun pcomplete/sudo ()
"Completion for the `sudo' command."
(while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (pcomplete-from-help "sudo --help"))
(when (pcomplete-match "\\`-[CDghpRtTUu]\\'") (pcomplete-here)))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
(provide 'pcmpl-unix)
;;; pcmpl-unix.el ends here

43
lisp/pcmpl-x.el
View file

@ -28,6 +28,22 @@
(eval-when-compile (require 'cl-lib))
(require 'pcomplete)
;;; TeX
;;;###autoload
(defun pcomplete/tex ()
"Completion for the `tex' command."
(pcomplete-here-using-help "tex --help"
:margin "^\\(?:\\[-no\\]\\)?\\(\\)-"))
;;;###autoload(defalias 'pcomplete/pdftex 'pcomplete/tex)
;;;###autoload(defalias 'pcomplete/latex 'pcomplete/tex)
;;;###autoload(defalias 'pcomplete/pdflatex 'pcomplete/tex)
;;;###autoload
(defun pcomplete/luatex ()
"Completion for the `luatex' command."
(pcomplete-here-using-help "luatex --help"))
;;;###autoload(defalias 'pcomplete/lualatex 'pcomplete/luatex)
;;;; tlmgr - https://www.tug.org/texlive/tlmgr.html
@ -142,6 +158,12 @@
(unless (pcomplete-match "^--" 0)
(pcomplete-here* (pcomplete-dirs-or-entries)))))))
;;; Grep-like tools
;;;###autoload
(defun pcomplete/rg ()
"Completion for the `rg' command."
(pcomplete-here-using-help "rg --help"))
;;;; ack - https://betterthangrep.com
@ -288,6 +310,8 @@ long options."
(pcmpl-x-ag-options))))
(pcomplete-here* (pcomplete-dirs-or-entries)))))
;;; Borland
;;;###autoload
(defun pcomplete/bcc32 ()
"Completion function for Borland's C++ compiler."
@ -321,5 +345,24 @@ long options."
;;;###autoload
(defalias 'pcomplete/bcc 'pcomplete/bcc32)
;;; Network tools
;;;###autoload
(defun pcomplete/rclone ()
"Completion for the `rclone' command."
(let ((subcmds (pcomplete-from-help "rclone help"
:margin "^ "
:argument "[a-z]+"
:narrow-start "\n\n")))
(while (not (member (pcomplete-arg 1) subcmds))
(pcomplete-here (completion-table-merge
subcmds
(pcomplete-from-help "rclone help flags"))))
(let ((subcmd (pcomplete-arg 1)))
(while (if (pcomplete-match "\\`-" 0)
(pcomplete-here (pcomplete-from-help
`("rclone" ,subcmd "--help")))
(pcomplete-here (pcomplete-entries)))))))
(provide 'pcmpl-x)
;;; pcmpl-x.el ends here

138
lisp/pcomplete.el
View file

@ -119,6 +119,9 @@
;;; Code:
(require 'comint)
(eval-when-compile
(require 'cl-lib)
(require 'rx))
(defgroup pcomplete nil
"Programmable completion."
@ -481,6 +484,14 @@ Same as `pcomplete' but using the standard completion UI."
(when completion-ignore-case
(setq table (completion-table-case-fold table)))
(list beg (point) table
:annotation-function
(lambda (cand)
(when (stringp cand)
(get-text-property 0 'pcomplete-annotation cand)))
:company-docsig
(lambda (cand)
(when (stringp cand)
(get-text-property 0 'pcomplete-help cand)))
:predicate pred
:exit-function
;; If completion is finished, add a terminating space.
@ -1325,6 +1336,133 @@ If specific documentation can't be given, be generic."
(pcomplete-read-hosts pcomplete-hosts-file 'pcomplete--host-name-cache
'pcomplete--host-name-cache-timestamp)))
;;; Parsing help messages
(defvar pcomplete-from-help (make-hash-table :test #'equal)
"Memoization table for function `pcomplete-from-help'.")
(cl-defun pcomplete-from-help (command
&rest args
&key
(margin (rx bol (+ " ")))
(argument (rx "-" (+ (any "-" alnum)) (? "=")))
(metavar (rx (? " ")
(or (+ (any alnum "_-"))
(seq "[" (+? nonl) "]")
(seq "<" (+? nonl) ">")
(seq "{" (+? nonl) "}"))))
(separator (rx ", " symbol-start))
(description (rx (* nonl)
(* "\n" (>= 9 " ") (* nonl))))
narrow-start
narrow-end)
"Parse output of COMMAND into a list of completion candidates.
COMMAND can be a string to be executed in a shell or a list of
strings (program name and arguments). It should print a help
message.
A list of arguments is collected after each match of MARGIN.
Each argument should match ARGUMENT, possibly followed by a match
of METAVAR. If a match of SEPARATOR follows, then more
argument-metavar pairs are collected. Finally, a match of
DESCRIPTION is collected.
Keyword ARGS:
MARGIN: regular expression after which argument descriptions are
to be found. Parsing continues at the end of the first match
group or, failing that, the entire match.
ARGUMENT: regular expression matching an argument name. The
first match group (failing that, the entire match) is collected
as the argument name. Parsing continues at the end of the
second matching group (failing that, the first group or entire
match).
METAVAR: regular expression matching an argument parameter name.
The first match group (failing that, the entire match) is
collected as the parameter name and used as completion
annotation. Parsing continues at the end of the second
matching group (failing that, the first group or entire match).
SEPARATOR: regular expression matching the separator between
arguments. Parsing continues at the end of the first match
group (failing that, the entire match).
DESCRIPTION: regular expression matching the description of an
argument. The first match group (failing that, the entire
match) is collected as the parameter name and used as
completion help. Parsing continues at the end of the first
matching group (failing that, the entire match).
NARROW-START, NARROW-END: if non-nil, parsing of the help message
is narrowed to the region between the end of the first match
group (failing that, the entire match) of these regular
expressions."
(with-memoization (gethash (cons command args) pcomplete-from-help)
(with-temp-buffer
(let ((case-fold-search nil)
(default-directory (expand-file-name "~/"))
(command (if (stringp command)
(list shell-file-name
shell-command-switch
command)
command))
i result)
(apply #'call-process (car command) nil t nil (cdr command))
(goto-char (point-min))
(narrow-to-region (or (and narrow-start
(re-search-forward narrow-start nil t)
(or (match-beginning 1) (match-beginning 0)))
(point-min))
(or (and narrow-end
(re-search-forward narrow-end nil t)
(or (match-beginning 1) (match-beginning 0)))
(point-max)))
(goto-char (point-min))
(while (re-search-forward margin nil t)
(goto-char (or (match-end 1) (match-end 0)))
(setq i 0)
(while (and (or (zerop i)
(and (looking-at separator)
(goto-char (or (match-end 1)
(match-end 0)))))
(looking-at argument))
(setq i (1+ i))
(goto-char (seq-some #'match-end '(2 1 0)))
(push (or (match-string 1) (match-string 0)) result)
(when (looking-at metavar)
(goto-char (seq-some #'match-end '(2 1 0)))
(put-text-property 0 1
'pcomplete-annotation
(or (match-string 1) (match-string 0))
(car result))))
(when (looking-at description)
(goto-char (seq-some #'match-end '(2 1 0)))
(let ((help (string-clean-whitespace
(or (match-string 1) (match-string 0))))
(items (take i result)))
(while items
(put-text-property 0 1 'pcomplete-help help
(pop items))))))
(nreverse result)))))
(defun pcomplete-here-using-help (command &rest args)
"Perform completion for a simple command.
Offer switches and directory entries as completion candidates.
The switches are obtained by calling `pcomplete-from-help' with
COMMAND and ARGS as arguments."
(while (cond
((string= "--" (pcomplete-arg 1))
(while (pcomplete-here (pcomplete-entries))))
((pcomplete-match "\\`--[^=]+=\\(.*\\)" 0)
(pcomplete-here (pcomplete-entries)
(pcomplete-match-string 1 0)))
((string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (apply #'pcomplete-from-help command args)))
(t (pcomplete-here (pcomplete-entries))))))
(provide 'pcomplete)
;;; pcomplete.el ends here

100
test/lisp/pcomplete-tests.el Normal file
View file

@ -0,0 +1,100 @@
;;; pcomplete-tests.el --- Tests for pcomplete.el -*- lexical-binding: t -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(require 'pcomplete)
(ert-deftest pcomplete-test-parse-gpg-help ()
(cl-letf ((pcomplete-from-help (make-hash-table :test #'equal))
((symbol-function 'call-process)
(lambda (&rest _) (insert "\
gpg (GnuPG) 2.3.7
Commands:
-s, --sign make a signature
--clear-sign make a clear text signature
-b, --detach-sign make a detached signature
--tofu-policy VALUE set the TOFU policy for a key
Options to specify keys:
-r, --recipient USER-ID encrypt for USER-ID
-u, --local-user USER-ID use USER-ID to sign or decrypt
(See the man page for a complete listing of all commands and options)
Examples:
-se -r Bob [file] sign and encrypt for user Bob
--clear-sign [file] make a clear text signature
"))))
(should
(equal-including-properties
(pcomplete-from-help "gpg --help" :narrow-end "^ -se")
'(#("-s" 0 1 (pcomplete-help "make a signature"))
#("--sign" 0 1 (pcomplete-help "make a signature"))
#("--clear-sign" 0 1 (pcomplete-help "make a clear text signature"))
#("-b" 0 1 (pcomplete-help "make a detached signature"))
#("--detach-sign" 0 1 (pcomplete-help "make a detached signature"))
#("--tofu-policy" 0 1
(pcomplete-help "set the TOFU policy for a key" pcomplete-annotation " VALUE"))
#("-r" 0 1 (pcomplete-help "encrypt for USER-ID"))
#("--recipient" 0 1
(pcomplete-help "encrypt for USER-ID" pcomplete-annotation " USER-ID"))
#("-u" 0 1
(pcomplete-help "use USER-ID to sign or decrypt"))
#("--local-user" 0 1
(pcomplete-help "use USER-ID to sign or decrypt" pcomplete-annotation " USER-ID")))))))
(ert-deftest pcomplete-test-parse-git-help ()
(cl-letf ((pcomplete-from-help (make-hash-table :test #'equal))
((symbol-function 'call-process)
(lambda (&rest _) (insert "\
usage: git [-v | --version] [-h | --help] [-C <path>] [-c <name>=<value>]
[--exec-path[=<path>]] [--html-path] [--man-path] [--info-path]
[-p | --paginate | -P | --no-pager] [--no-replace-objects] [--bare]
[--git-dir=<path>] [--work-tree=<path>] [--namespace=<name>]
[--super-prefix=<path>] [--config-env=<name>=<envvar>]
<command> [<args>]
"))))
(should
(equal-including-properties
(pcomplete-from-help "git help"
:margin "\\(\\[\\)-"
:separator " | "
:description "\\`")
'("-v" "--version" "-h" "--help"
#("-C" 0 1 (pcomplete-annotation " <path>"))
#("-c" 0 1 (pcomplete-annotation " <name>"))
#("--exec-path" 0 1 (pcomplete-annotation "[=<path>]"))
"--html-path" "--man-path" "--info-path"
"-p" "--paginate" "-P" "--no-pager"
"--no-replace-objects" "--bare"
#("--git-dir=" 0 1 (pcomplete-annotation "<path>"))
#("--work-tree=" 0 1 (pcomplete-annotation "<path>"))
#("--namespace=" 0 1 (pcomplete-annotation "<name>"))
#("--super-prefix=" 0 1 (pcomplete-annotation "<path>"))
#("--config-env=" 0 1 (pcomplete-annotation "<name>")))))))
(provide 'pcomplete-tests)
;;; pcomplete-tests.el ends here