unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#57673: [PATCH] Parse --help messages for pcomplete
@ 2022-09-08  9:34 Augusto Stoffel
  2022-09-08 12:39 ` Lars Ingebrigtsen
  2022-09-08 20:49 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
  0 siblings, 2 replies; 21+ messages in thread
From: Augusto Stoffel @ 2022-09-08  9:34 UTC (permalink / raw)
  To: 57673

[-- Attachment #1: Type: text/plain, Size: 1142 bytes --]

Tags: patch

Find attached a “worse is better” approach for pcomplete, where we parse
help messages to generate a list of completions.

This is still a sketch.  I've added pcomplete functions for a random
selection of commands to see if this works reasonably, and I think it
probably does.  But in any case I don't think it would make sense to try
and add completions as detailed as the ones bash provides; there is an
awful lot of logic in the files under /usr/share/bash-completion and I
don't think anyone would want to redo that work.

Some further comments:

1. I'm a bit unsure whether `pcomplete-parse-help' should return a plain
   list of completions or a completion table.  The advantage of the
   former (which is the current approach) is that it's easier to
   manipulate the result of the parsing (cf. the need for that in the
   git case).  The advantage of returning a completion table is a better
   treatment of annotations.

2. I would rather not create a new pcmpl-git.el file (doing so for each
   new command doesn't seem very scalable), but I wouldn't know where
   else to put that stuff.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-pcomplete-parse-help.patch --]
[-- Type: text/patch, Size: 19781 bytes --]

From 5bcd9c3c84a95f1219411f91b03fcea0ad99beae Mon Sep 17 00:00:00 2001
From: Augusto Stoffel <arstoffel@gmail.com>
Date: Thu, 8 Sep 2022 11:09:42 +0200
Subject: [PATCH] Add pcomplete-parse-help

---
 lisp/pcmpl-git.el            |  97 +++++++++++++++++++++++++++++++
 lisp/pcmpl-gnu.el            |  22 +++++++
 lisp/pcmpl-rpm.el            |  39 +++++++++++++
 lisp/pcmpl-x.el              |  16 ++++++
 lisp/pcomplete.el            | 107 +++++++++++++++++++++++++++++++++++
 test/lisp/pcomplete-tests.el | 100 ++++++++++++++++++++++++++++++++
 6 files changed, 381 insertions(+)
 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..369f66742c
--- /dev/null
+++ b/lisp/pcmpl-git.el
@@ -0,0 +1,97 @@
+;;; 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:
+
+;;; 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 ()
+  "Return a predicate function determining if a file is tracked by git."
+  (when-let ((files (ignore-errors
+                      (process-lines vc-git-program "ls-files")))
+             (table (make-hash-table :test #'equal)))
+    (dolist (file files) (puthash (expand-file-name file) t table))
+    (lambda (file) (or (gethash (expand-file-name file) table)
+                       (string-suffix-p "/" file)))))
+
+(defun pcmpl-git--remote-refs (remote)
+  "List the locally known git revisions from REMOTE.
+If REMOTE is nil, return the list of remotes."
+  (if (null remote)
+      (ignore-errors
+        (process-lines vc-git-program "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 ((subcmds (pcomplete-parse-help "git help -a"
+                                       :margin "^\\( +\\)[a-z]"
+                                       :argument "[-a-z]+")))
+    (while (not (member (pcomplete-arg 1) subcmds))
+      (pcomplete-here (append subcmds
+                              (pcomplete-parse-help "git help"
+                                                    :margin "\\(\\[\\)-"
+                                                    :separator " | "
+                                                    :description "\\`"))))
+    (let ((subcmd (pcomplete-arg 1)))
+      (while (pcase subcmd
+               ((guard (pcomplete-match "\\`-" 0))
+                (pcomplete-here
+                 (pcmpl-git--expand-flags
+                  (pcomplete-parse-help (format "git help %s" subcmd)
+                                        :argument "-+\\(?:\\[no-\\]\\)?[a-z-]+=?"))))
+               ;; Complete tracked files
+               ((or "mv" "rm" "restore" "grep" "status" "commit")
+                (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 (pcmpl-git--remote-refs nil))
+                (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..639e0bac45 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -394,6 +394,28 @@ pcomplete/find
     (while (pcomplete-here (pcomplete-dirs) nil #'identity))))
 
 ;;;###autoload
+(defun pcomplete/awk ()
+  "Completion for the GNU Privacy Guard."
+  (while (pcomplete-match "^-" 0)
+    (pcomplete-here (pcomplete-parse-help "awk --help"
+                                          :margin "\t"
+                                          :separator "  +"
+                                          :description "\0"
+                                          :metavar "[=a-z]+"))))
+
+;;;###autoload
+(defun pcomplete/gpg ()
+  "Completion for the GNU Privacy Guard."
+  (while (pcomplete-match "^-" 0)
+    (pcomplete-here (pcomplete-parse-help "gpg --help" :narrow-end "^ -se"))))
+
+;;;###autoload
+(defun pcomplete/gdb ()
+  "Completion for the GNU debugger."
+  (while (pcomplete-match "^-" 0)
+    ;; FIXME: space is inserted after options ending in "=".
+    (pcomplete-here (pcomplete-parse-help "gdb --help"))))
+
 (defalias 'pcomplete/gdb 'pcomplete/xargs)
 
 ;;; pcmpl-gnu.el ends here
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index f7925d9d9e..1d833eaa91 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -378,6 +378,45 @@ 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-parse-help "dnf help"
+                                       :margin "^\\(\\)[a-z-]+  "
+                                       :argument "[a-z-]+")))
+    (while (not (member (pcomplete-arg 1) subcmds))
+      (pcomplete-here (append subcmds
+                              (pcomplete-parse-help "dnf help"))))
+    (let ((subcmd (pcomplete-arg 1)))
+      (while (pcase subcmd
+               ((guard (pcomplete-match "\\`-" 0))
+                (pcomplete-here
+                 (pcomplete-parse-help (format "dnf help %s" 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-x.el b/lisp/pcmpl-x.el
index 261a3d4e27..479d549a3d 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -321,5 +321,21 @@ pcomplete/bcc32
 ;;;###autoload
 (defalias 'pcomplete/bcc 'pcomplete/bcc32)
 
+;;;###autoload
+(defun pcomplete/rclone ()
+  "Completion for the `rclone' command."
+  (let ((subcmds (pcomplete-parse-help "rclone help"
+                                       :margin "^  "
+                                       :argument "[a-z]+"
+                                       :narrow-start "\n\n")))
+    (while (not (member (pcomplete-arg 1) subcmds))
+      (pcomplete-here (append subcmds
+                              (pcomplete-parse-help "rclone help flags"))))
+    (let ((subcmd (pcomplete-arg 1)))
+      (while (if (pcomplete-match "\\`-" 0)
+                 (pcomplete-here (pcomplete-parse-help
+                                  (format "rclone %s --help" subcmd)))
+               (pcomplete-here (pcomplete-entries)))))))
+
 (provide 'pcmpl-x)
 ;;; pcmpl-x.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 15b9880df8..c7b49c5596 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."
@@ -485,6 +488,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.
@@ -1332,6 +1343,102 @@ pcomplete-read-host-names
       (pcomplete-read-hosts pcomplete-hosts-file 'pcomplete--host-name-cache
                    'pcomplete--host-name-cache-timestamp)))
 
+;;; Parsing of help messages
+
+(defvar pcomplete-parse-help (make-hash-table :test #'equal)
+  "Hash table for memoization of function `pcomplete-parse-help'.")
+
+(cl-defun pcomplete-parse-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" (>= 8 " ") (* nonl))))
+                                narrow-start
+                                narrow-end
+                                &aux
+                                result)
+  "Parse output of COMMAND into a list of completion candidates.
+
+A list of arguments is expected 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 expected.  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 at the end of the match.
+
+ARGUMENT: regular expression matching an argument name.  The
+  first match group (or the entire match if missing) is collected
+  as the argument name.  Parsing continues at the end of the
+  second matching group (or first group, or entire match).
+
+METAVAR: regular expression matching an argument parameter name.
+  The first match group (or the entire match if missing) is
+  collected as the parameter name and used as completion
+  annotation.  Parsing continues at the end of the second
+  matching group (or first group, or entire match).
+
+SEPARATOR: regular expression matching the separator between
+  arguments.  Parsing continues at the end of the first match
+  group, or at the end of the match.
+
+DESCRIPTION: regular expression matching the description of an
+  argument.  The first match group (or the entire match if
+  missing) is collected as the parameter name and used as
+  completion help.  Parsing continues at the end of the first
+  matching group or entire match.
+
+NARROW-START, NARROW-END: if non-nil, parsing of help message is
+  narrowed to the region between the (end of) the first match of
+  these regular expressions."
+  (with-memoization (gethash (cons command args) pcomplete-parse-help)
+    (with-temp-buffer
+      (call-process-shell-command command nil t)
+      (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)))
+        (let ((i 0))
+          (while (and (or (zerop i)
+                          (prog1 (looking-at separator)
+                            (goto-char (or (match-end 1)
+                                           (match-end 0)))))
+                      (looking-at argument))
+            (cl-incf i)
+            (push (or (match-string 1) (match-string 0)) result)
+            (goto-char (seq-some #'match-end '(2 1 0)))
+            (when (looking-at metavar)
+              (put-text-property 0 1 'pcomplete-annotation
+                                 (or (match-string 1) (match-string 0))
+                                 (car result))
+              (goto-char (seq-some #'match-end '(2 1 0)))))
+          (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)))))
+              (dotimes (j i)
+                (put-text-property 0 1 'pcomplete-help help (nth j result))))))))
+    (nreverse result)))
+
 (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..c034f02c4f
--- /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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'pcomplete)
+
+(ert-deftest pcomplete-test-parse-help-gpg ()
+  (cl-letf ((pcomplete-parse-help (make-hash-table :test #'equal))
+            ((symbol-function 'call-process-shell-command)
+             (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-parse-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-help-git ()
+  (cl-letf ((pcomplete-parse-help (make-hash-table :test #'equal))
+            ((symbol-function 'call-process-shell-command)
+             (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-parse-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
-- 
2.37.3


^ permalink raw reply related	[flat|nested] 21+ messages in thread
end of thread, other threads:[~2022-09-14 21:45 UTC | newest]

Thread overview: 21+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-09-08  9:34 bug#57673: [PATCH] Parse --help messages for pcomplete Augusto Stoffel
2022-09-08 12:39 ` Lars Ingebrigtsen
2022-09-08 13:05   ` Augusto Stoffel
2022-09-09 17:02     ` Lars Ingebrigtsen
2022-09-10  9:20       ` Augusto Stoffel
2022-09-08 20:49 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-09-08 21:53   ` Augusto Stoffel
2022-09-09  2:47     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-09-10  9:45       ` Augusto Stoffel
2022-09-10 14:32         ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-09-10 16:12           ` Augusto Stoffel
2022-09-14 19:15           ` Augusto Stoffel
2022-09-14 19:21             ` Lars Ingebrigtsen
2022-09-14 19:41               ` Augusto Stoffel
2022-09-14 19:48                 ` Lars Ingebrigtsen
2022-09-14 19:57                   ` Augusto Stoffel
2022-09-14 19:59                     ` Lars Ingebrigtsen
2022-09-14 20:40                   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-09-14 21:11                     ` Lars Ingebrigtsen
2022-09-14 21:23                     ` Augusto Stoffel
2022-09-14 21:45                       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).