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

@@ -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

lisp/pcmpl-gnu.el

@@ -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

lisp/pcmpl-linux.el

@@ -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

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 @@
        (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