From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Augusto Stoffel Newsgroups: gmane.emacs.bugs Subject: bug#57673: [PATCH] Parse --help messages for pcomplete Date: Sat, 10 Sep 2022 11:45:08 +0200 Message-ID: <87pmg3ef6j.fsf@gmail.com> References: <87zgfagqfs.fsf@gmail.com> <87sfl1leip.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="35236"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: Lars Ingebrigtsen , 57673@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Sep 10 11:46:28 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1oWx4D-0008yK-Vs for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 10 Sep 2022 11:46:26 +0200 Original-Received: from localhost ([::1]:53020 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oWx4C-0007MR-CY for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 10 Sep 2022 05:46:24 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:40896) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oWx40-0007MI-B4 for bug-gnu-emacs@gnu.org; Sat, 10 Sep 2022 05:46:12 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:47904) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oWx3q-0006i5-8u for bug-gnu-emacs@gnu.org; Sat, 10 Sep 2022 05:46:12 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oWx3q-0005un-0G for bug-gnu-emacs@gnu.org; Sat, 10 Sep 2022 05:46:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Augusto Stoffel Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 10 Sep 2022 09:46:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 57673 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 57673-submit@debbugs.gnu.org id=B57673.166280312622690 (code B ref 57673); Sat, 10 Sep 2022 09:46:01 +0000 Original-Received: (at 57673) by debbugs.gnu.org; 10 Sep 2022 09:45:26 +0000 Original-Received: from localhost ([127.0.0.1]:36603 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oWx3E-0005ts-Qx for submit@debbugs.gnu.org; Sat, 10 Sep 2022 05:45:25 -0400 Original-Received: from mail-ej1-f41.google.com ([209.85.218.41]:41562) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oWx3C-0005tc-6B for 57673@debbugs.gnu.org; Sat, 10 Sep 2022 05:45:23 -0400 Original-Received: by mail-ej1-f41.google.com with SMTP id gh9so9474634ejc.8 for <57673@debbugs.gnu.org>; Sat, 10 Sep 2022 02:45:22 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date; bh=qY+6TVTjs9OFnBg1nKGi9uPjLE8ifjO+m/FuwsUGY7w=; b=BN3p4Bkr5/C3YQl8z5ZrBS+W+EJgTDfhDIrvLrY/oYiZowwH2h7l2OB4nYhep+fCXA Txsii72ZHZK71CbUnqZLzXRI4WSlGRXY+G1W8Qk+Q1CCRDNTcVTPIoHb30r1faoPpRmm wpN50EJf9htouMjcTOWg3e1QwWV1ThU8sgARwMgQmJ6I8a6r59DgjlYHmm/M462qPPcv G4c7iM3mRR68/cPUhaalOhcyqTmvUa5oTzYY330/UQ7FconjFCYV0xiqFrqv7uLfXxX6 2A1rUmSs8x13YvUQrquB/upbufxWS3SoXYittWzBurIbPGc6Wg3ePeDEXT+hrkeLhVXJ eWtg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date; bh=qY+6TVTjs9OFnBg1nKGi9uPjLE8ifjO+m/FuwsUGY7w=; b=yhDYJe9HToseiICF0vR9+Iwh+j3nTdJ0gZc23eNSezPj3HhtEVxtyqUh/zo65TiiuC i4Y0L78QWX1E2F8TsAwyBKrKsp3JihIXXmni1iwcsJHNIn9F9p8dB04Rpcz5Lg3zLs8S jgbkZdHiHRVskU6QGezkxZc5xKfpOvVoIsjZ4CImeaQWMs4pDW7Jk8CrKPOMlUaH5Wtx FoNOD/bi9Rg58EFO5h+sFmwYNxJVUTFyCGpPynxbuFtQd74nrGKEcnTvw4YYlhXR0CPz JbUgzZgAHMDry0yQHmS9Uyh3u5qbf/8RX7K6FoekdvEHBKbf3mv2k0P3OvksJKHg+lZc pAWA== X-Gm-Message-State: ACgBeo33VyE7FgbvJxRLDl6Q1RfXoEdZ/H3ReGot7MPdqaIL4/RVjD/z dduvXWlSTIosJ0TgX/7wfRzWl7WBuPo= X-Google-Smtp-Source: AA6agR5whBIU9uuHnFasPXikIHrKMxofQ8v/wkG9tKYoMadeESLYreonyDx3fP9SJUouRbk/XKZrqg== X-Received: by 2002:a17:906:dac3:b0:748:8cbf:3c50 with SMTP id xi3-20020a170906dac300b007488cbf3c50mr12500534ejb.136.1662803112145; Sat, 10 Sep 2022 02:45:12 -0700 (PDT) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::157b]) by smtp.gmail.com with ESMTPSA id h5-20020a0564020e0500b00450f338b9c8sm1824257edh.69.2022.09.10.02.45.09 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 10 Sep 2022 02:45:09 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Thu, 08 Sep 2022 22:47:26 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:242092 Archived-At: --=-=-= Content-Type: text/plain Hi Stefan, I've attached a new iteration of the patch. I think the git completion should be pretty usable (but certainly can be refined in the future). I'm also satisfied with the parser, please have a look if you are interested. Next I'd like to think now of a good way to add batches of simpler commands, say all GNU coreutils. This would entail repeating variations of (defun pcomplete/gpg () "Completion for the GNU Privacy Guard." (while (if (pcomplete-match "\\`-" 0) (pcomplete-here (pcomplete-from-help "gpg --help" :narrow-end "^ -se")) (pcomplete-here (pcomplete-entries))))) over and over, so I was wondering if it makes sense to add a macro to help here. See a suggestion at the end of pcomplete.el. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-pcomplete-Generate-completions-from-help-messages.patch >From d0b150d8ae742eb5bf329287e73b751f7ab2e2ca 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/pcmpl-git.el | 110 +++++++++++++++++++++++++++ lisp/pcmpl-gnu.el | 30 ++++++++ lisp/pcmpl-rpm.el | 44 ++++++++++- lisp/pcmpl-x.el | 17 +++++ lisp/pcomplete.el | 142 +++++++++++++++++++++++++++++++++++ test/lisp/pcomplete-tests.el | 100 ++++++++++++++++++++++++ 6 files changed, 442 insertions(+), 1 deletion(-) 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..1ff82f2b81 --- /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 if a file is tracked by Git. +ARGS are passed to the `git ls-files' command." + (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 ((subcmds (pcomplete-from-help `(,vc-git-program "help" "-a") + :margin "^\\( +\\)[a-z]" + :argument "[[:alnum:]-]+"))) + (while (not (member (pcomplete-arg 1) subcmds)) + (pcomplete-here (completion-table-merge + subcmds + ;; Global switches and their file arguments + (pcomplete-from-help `(,vc-git-program "help") + :margin "\\(\\[\\)-" + :separator " | " + :description "\\`") + (when (pcomplete-match "\\-") + (pcomplete-entries))))) + (let ((subcmd (pcomplete-arg 1))) + (while (pcase subcmd + ((guard (pcomplete-match "\\`-" 0)) + (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..f957e7cbb4 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -394,6 +394,36 @@ pcomplete/find (while (pcomplete-here (pcomplete-dirs) nil #'identity)))) ;;;###autoload +(defun pcomplete/awk () + "Completion for the `awk' command." + (while (pcomplete-here + (completion-table-in-turn + (pcomplete-from-help "awk --help" + :margin "\t" + :separator " +" + :description "\0" + :metavar "[=a-z]+") + (pcomplete-entries))))) + +;;;###autoload +(defun pcomplete/gpg () + "Completion for the GNU Privacy Guard." + (while (pcomplete-here + (completion-table-in-turn + (pcomplete-from-help "gpg --help" :narrow-end "^ -se") + (pcomplete-entries))))) + +;; This is going to get tedious pretty quickly, how about introducing +;; a macro for the simple cases? +(define-simple-pcomplete awk "awk --help" + :margin "\t" + :separator " +" + :description "\0" + :metavar "[=a-z]+") +(define-simple-pcomplete gpg "gpg --help" :narrow-end "^ -se") +(define-simple-pcomplete ls "ls --help") +(define-simple-pcomplete grep "grep --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..7c602d0f9b 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,47 @@ 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-x.el b/lisp/pcmpl-x.el index 261a3d4e27..78963410ee 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -321,5 +321,22 @@ pcomplete/bcc32 ;;;###autoload (defalias 'pcomplete/bcc 'pcomplete/bcc32) +;;;###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 15b9880df8..3bf0e2be2c 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,137 @@ 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 list (program name and arguments) or a string to +be executed in a shell. 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 at the end of the entire 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-from-help) + (with-temp-buffer + (let ((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--simple-command (command args) + "Helper function for `define-simple-pcomplete'." + (while (pcomplete-here + (completion-table-merge + (apply #'pcomplete-from-help command args) + (pcomplete-entries))))) + +;; What do you think of a macro like this? +(defmacro define-simple-pcomplete (name command &rest args) + "Create `pcomplete' completions for a simple command. +COMMAND and ARGS are as in `pcomplete-from-help'. Completion +candidates for this command will include the parsed arguments as +well as files." + (let* ((namestr (symbol-name name)) + (docstring (if-let ((i (string-search "/" namestr))) + (format "Completions for the `%s' command in `%s'." + (substring namestr 0 i) + (substring namestr i)) + (format "Completions for the `%s' command." namestr)))) + `(defun ,(intern (concat "pcomplete/" namestr)) () + ,docstring + (pcomplete--simple-command ,command ',args)))) + (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 --=-=-=--