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.

1 files changed, 138 insertions, 0 deletions

diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 0e3d1df7814..6fe29d9dcfb 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 @@ 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