From 5bcd9c3c84a95f1219411f91b03fcea0ad99beae Mon Sep 17 00:00:00 2001 From: Augusto Stoffel 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 . + +;;; 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 . + +;;; 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 ] [-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-parse-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