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: Thu, 08 Sep 2022 11:34:31 +0200 Message-ID: <87zgfagqfs.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="35531"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) To: 57673@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Sep 08 11:36:06 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 1oWDx7-00091f-Dv for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 08 Sep 2022 11:36:05 +0200 Original-Received: from localhost ([::1]:49730 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oWDx5-0004da-GA for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 08 Sep 2022 05:36:03 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:55484) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oWDwC-0004c1-0l for bug-gnu-emacs@gnu.org; Thu, 08 Sep 2022 05:35:08 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:40355) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oWDw7-0002oD-EA for bug-gnu-emacs@gnu.org; Thu, 08 Sep 2022 05:35:05 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oWDw6-00087s-NX for bug-gnu-emacs@gnu.org; Thu, 08 Sep 2022 05:35: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: Thu, 08 Sep 2022 09:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 57673 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.166262968231201 (code B ref -1); Thu, 08 Sep 2022 09:35:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 8 Sep 2022 09:34:42 +0000 Original-Received: from localhost ([127.0.0.1]:57287 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oWDvl-00087A-AP for submit@debbugs.gnu.org; Thu, 08 Sep 2022 05:34:42 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:35808) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oWDvi-000871-SI for submit@debbugs.gnu.org; Thu, 08 Sep 2022 05:34:39 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:32960) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oWDvi-0004Kb-Kk for bug-gnu-emacs@gnu.org; Thu, 08 Sep 2022 05:34:38 -0400 Original-Received: from mail-ed1-x529.google.com ([2a00:1450:4864:20::529]:33701) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oWDvf-0002jW-KJ for bug-gnu-emacs@gnu.org; Thu, 08 Sep 2022 05:34:38 -0400 Original-Received: by mail-ed1-x529.google.com with SMTP id b35so5432375edf.0 for ; Thu, 08 Sep 2022 02:34:35 -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:subject:to:from:from:to:cc :subject:date; bh=oAM1lQXuEc0Vf0dR4YzXJH2yok2Rxj8vDSUODMahl1s=; b=X5Z3Z5nrEn/1h3kHFpI+EZo0feeg7iwaoL61tj1UNHQor6N5JB1DNyjDs+mETFpsHh wSbgV0romCDeHzijeeTeTFyUTBYHRNDnGlaP6Bd6hZ0JCIu9l/U0BVJsftLrfNGr0nXK z/ST3mhwERjnR+VlihkuvyPVDgXH9GUaLfL3uMOO70Bh1LBFNfQitmrZvVsyLr16vI4G vPKd4RAEyQylRKqoL8lgYLpD+uSt1q2tdR20AxAlNUNtNvfj9X80GRhA1avlU1rWivnQ pXaoQCJNhW4rMi2ufeFvaMHmMkAdKjewWALuQgoQ6NzKFOruxf3O++I7SC+1iMzSP11U yFPw== 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:subject:to:from :x-gm-message-state:from:to:cc:subject:date; bh=oAM1lQXuEc0Vf0dR4YzXJH2yok2Rxj8vDSUODMahl1s=; b=mRz/bseiakpcGsWHg/P1Y/k45qOFUeaycx0GR4qhQuezrpIRtl89E6rATgRI/KyTOg 3T+lmyKVhj3H7fK+5HtbnCHWt5gyoqYeKEid4iux5SBrhEsdy3LMBcqtVRHwiqgWn+0j eqIziE09c+dE1h5WWgJNehnjdYZAJ7GqtsLiDR9kKkzmcumpHZyjdLns/RNz0srBKeCk 3LeJGoRfmx4PhLdRdHaUOoKfvughuNp1fdawJp4R23CdMV00u8cKIIgMaDtCzsEAtXvy m60ZnToApu/wzBIeecBvQF8h7c7nZjPvPR270g4gek/cHNI4TUUAU50mk3CkDlqs02ks 8tFw== X-Gm-Message-State: ACgBeo1zOzLvkdnLNr8OniqhH4Y7dwZEzg7BFKn2V97UexZB75LXH3pP 3WYjLdFIgiAU2WWbs2jzMRn2tuFxUhI= X-Google-Smtp-Source: AA6agR5VmEJOeE9NJHt9C3Z5HXfAUYxjzYGZHjI1L4Q0XNFI9xqW4errwmMCcNpE+jDQTKG4strksQ== X-Received: by 2002:a05:6402:350b:b0:43e:f4be:c447 with SMTP id b11-20020a056402350b00b0043ef4bec447mr6524171edd.427.1662629673502; Thu, 08 Sep 2022 02:34:33 -0700 (PDT) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::157b]) by smtp.gmail.com with ESMTPSA id t25-20020aa7db19000000b0044e7c20d7a9sm7887836eds.37.2022.09.08.02.34.32 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 08 Sep 2022 02:34:32 -0700 (PDT) Received-SPF: pass client-ip=2a00:1450:4864:20::529; envelope-from=arstoffel@gmail.com; helo=mail-ed1-x529.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action 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:241852 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Tags: patch Find attached a =E2=80=9Cworse is better=E2=80=9D approach for pcomplete, w= here 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. --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=0001-Add-pcomplete-parse-help.patch >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 --=-=-=--