From d8a839b5e4df4da2b6794cd406bdd63fd28f4954 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Thu, 8 Sep 2022 11:09:42 +0200 Subject: [PATCH] pcomplete: Generate completions from --help messages * 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. --- lisp/pcmpl-git.el | 110 ++++++++ lisp/pcmpl-gnu.el | 36 ++- lisp/pcmpl-linux.el | 68 +++++ lisp/pcmpl-rpm.el | 43 ++- lisp/pcmpl-unix.el | 490 +++++++++++++++++++++++++++++++++-- lisp/pcmpl-x.el | 43 +++ lisp/pcomplete.el | 138 ++++++++++ test/lisp/pcomplete-tests.el | 100 +++++++ 8 files changed, 1004 insertions(+), 24 deletions(-) create mode 100644 lisp/pcmpl-git.el create mode 100644 test/lisp/pcomplete-tests.el diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el new file mode 100644 index 0000000000..3584fa0673 --- /dev/null +++ b/lisp/pcmpl-git.el @@ -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 . + +;;; 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 diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 3c9bf1ec9d..cdfde5640a 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -394,6 +394,40 @@ pcomplete/find (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 diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 7c072f3d40..023c655a2a 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -30,6 +30,7 @@ (provide 'pcmpl-linux) (require 'pcomplete) +(eval-when-compile (require 'rx)) ;; Functions: @@ -111,4 +112,71 @@ pcmpl-linux-mountable-directories (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 diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index f7925d9d9e..ebb6b72600 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -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 @@ pcomplete/rpm (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 diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index 8774f091c8..0c32f814d0 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -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 @@ pcmpl-ssh-config-file :group 'pcmpl-unix :version "24.1") -;; Functions: +;;; Shell builtins and core utilities ;;;###autoload (defun pcomplete/cd () @@ -69,34 +69,38 @@ 'pcomplete/pushd ;;;###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 @@ pcmpl-unix-user-names (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 @@ pcomplete/telnet (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 diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 261a3d4e27..1ede867c5f 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -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 @@ pcomplete/tlmgr (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 @@ pcomplete/ag (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 @@ pcomplete/bcc32 ;;;###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 diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 0e3d1df781..6fe29d9dcf 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -119,6 +119,9 @@ ;;; Code: (require 'comint) +(eval-when-compile + (require 'cl-lib) + (require 'rx)) (defgroup pcomplete nil "Programmable completion." @@ -481,6 +484,14 @@ pcomplete-completions-at-point (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 @@ pcomplete-read-host-names (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 diff --git a/test/lisp/pcomplete-tests.el b/test/lisp/pcomplete-tests.el new file mode 100644 index 0000000000..00a82502f3 --- /dev/null +++ b/test/lisp/pcomplete-tests.el @@ -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 . + +;;; 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 ] [-c =] + [--exec-path[=]] [--html-path] [--man-path] [--info-path] + [-p | --paginate | -P | --no-pager] [--no-replace-objects] [--bare] + [--git-dir=] [--work-tree=] [--namespace=] + [--super-prefix=] [--config-env==] + [] +")))) + (should + (equal-including-properties + (pcomplete-from-help "git help" + :margin "\\(\\[\\)-" + :separator " | " + :description "\\`") + '("-v" "--version" "-h" "--help" + #("-C" 0 1 (pcomplete-annotation " ")) + #("-c" 0 1 (pcomplete-annotation " ")) + #("--exec-path" 0 1 (pcomplete-annotation "[=]")) + "--html-path" "--man-path" "--info-path" + "-p" "--paginate" "-P" "--no-pager" + "--no-replace-objects" "--bare" + #("--git-dir=" 0 1 (pcomplete-annotation "")) + #("--work-tree=" 0 1 (pcomplete-annotation "")) + #("--namespace=" 0 1 (pcomplete-annotation "")) + #("--super-prefix=" 0 1 (pcomplete-annotation "")) + #("--config-env=" 0 1 (pcomplete-annotation ""))))))) + +(provide 'pcomplete-tests) +;;; pcomplete-tests.el ends here -- 2.37.3