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: Wed, 14 Sep 2022 21:57:09 +0200 Message-ID: <87y1ulbuga.fsf@gmail.com> References: <87zgfagqfs.fsf@gmail.com> <87sfl1leip.fsf@gmail.com> <87pmg3ef6j.fsf@gmail.com> <877d25day5.fsf@gmail.com> <87edwd3gpv.fsf@gnus.org> <8735ctd9qe.fsf@gmail.com> <87a6713ffm.fsf@gnus.org> 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="12701"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: 57673@debbugs.gnu.org, Stefan Monnier To: Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Sep 14 21:58:11 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 1oYYWR-00033n-Gc for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 14 Sep 2022 21:58:11 +0200 Original-Received: from localhost ([::1]:46760 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oYYWQ-0004YZ-Ki for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 14 Sep 2022 15:58:10 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:34862) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oYYWI-0004Y3-9r for bug-gnu-emacs@gnu.org; Wed, 14 Sep 2022 15:58:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:39388) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oYYWI-0002Ux-2E for bug-gnu-emacs@gnu.org; Wed, 14 Sep 2022 15:58:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oYYWH-0004jR-JQ for bug-gnu-emacs@gnu.org; Wed, 14 Sep 2022 15:58:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Augusto Stoffel Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 14 Sep 2022 19:58: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.166318544318140 (code B ref 57673); Wed, 14 Sep 2022 19:58:01 +0000 Original-Received: (at 57673) by debbugs.gnu.org; 14 Sep 2022 19:57:23 +0000 Original-Received: from localhost ([127.0.0.1]:56320 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oYYVd-0004iU-9e for submit@debbugs.gnu.org; Wed, 14 Sep 2022 15:57:23 -0400 Original-Received: from mail-ed1-f44.google.com ([209.85.208.44]:36748) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oYYVa-0004iF-4j for 57673@debbugs.gnu.org; Wed, 14 Sep 2022 15:57:20 -0400 Original-Received: by mail-ed1-f44.google.com with SMTP id e18so23911474edj.3 for <57673@debbugs.gnu.org>; Wed, 14 Sep 2022 12:57:18 -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=DH/XAj9u5bY09GpNlRVO0xPIMW7cnqUIHPKw/fHAlOQ=; b=WEIG3S1XdIS4GP/H90OTvdZUf8bsUCXpkWpXPV4smXiLw0x/9iuI7vVRVyj7+IkJ0u KlIAREeQztWr2mNvthrNWPRwEQWa/l/WRm8tK0J4OLivLmYWY9Bf6suIkkYfiWvAyUmm ISlkZFbZrd7+Eb6T/O3zL9BtjWcVE4cfnBeoBCrCOuTln233njcqi+JwQG2KcftrFDlK 7RlhWyWBwNDWa27xzU79Okf3nH12PaThQfGATHGayVVlkdvqm/NSsEhvacvxqAjWfKlK vOfMv+VHGopFHG/4FhV4ZT4+OIfivpH6D474KpJqtEYUK6pBuAtvys/OibtuRj5CQXUn 7Ydw== 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=DH/XAj9u5bY09GpNlRVO0xPIMW7cnqUIHPKw/fHAlOQ=; b=zHDJsv/OQi5s2KtpCj6f0IwdXEshK8Y5gYnNpazQBc0mSF1o0jm/d+GtXgxXJ6wTn1 I5trYtaQOx2lUBii5dOetM09hcJmgnG+KZySpZ+NGaHSP3GJz3BogUmc83Ku/tgeYjiM AhAilL5aovLH4NCYYuvtOj0CRs9hw4WF2/5buE8gbD20YGk4RtD7PQhXiG8a1WP4Fawi RShteLxGbZ+zO2r3LyY2BdBDaixsEI0pwnAmesc/DHAfpKC3YQvhcoP7HmNkmxW0706h ollMl01zjx/tlFF3ERGOQpsV5PjgOAcs71zdnZxqtyz2zS2y33QvVoL8KcQMKvQfhjND XBDw== X-Gm-Message-State: ACgBeo0giLm4aY7AFRl7051nNNqsJVDWt374s/hx0UxW4fDPQ6T8hKog zSsejyOIyrCyG8pJnV+xaGUFVLXtMB0= X-Google-Smtp-Source: AA6agR57ROVOgSB5JNSo65DsWEJg+dUnAMWlfTj9FodP35yQQT7JmrIFX21UdH0AbLmh+imR2RxyzQ== X-Received: by 2002:aa7:da4f:0:b0:44e:864b:7a3e with SMTP id w15-20020aa7da4f000000b0044e864b7a3emr32725392eds.378.1663185431863; Wed, 14 Sep 2022 12:57:11 -0700 (PDT) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::8510]) by smtp.gmail.com with ESMTPSA id m22-20020aa7c496000000b0044f1bd0fbd1sm10366879edq.34.2022.09.14.12.57.10 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 14 Sep 2022 12:57:10 -0700 (PDT) In-Reply-To: <87a6713ffm.fsf@gnus.org> (Lars Ingebrigtsen's message of "Wed, 14 Sep 2022 21:48:45 +0200") 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:242530 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable On Wed, 14 Sep 2022 at 21:48, Lars Ingebrigtsen wrote: > Augusto Stoffel writes: > >> I've attached a patch to be applied (and squashed) on top of what I sent >> previously. Let me know if this is inconvenient and I'll send the whole >> thing. > > I'd prefer the whole thing in one patch. Voil=C3=A0. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-pcomplete-Generate-completions-from-help-messages.patch >From d8a839b5e4df4da2b6794cd406bdd63fd28f4954 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/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. --- lisp/pcmpl-git.el | 110 ++++++++ lisp/pcmpl-gnu.el | 36 ++- lisp/pcmpl-linux.el | 68 +++++ lisp/pcmpl-rpm.el | 43 ++- lisp/pcmpl-unix.el | 490 +++++++++++++++++++++++++++++++++-- lisp/pcmpl-x.el | 43 +++ lisp/pcomplete.el | 138 ++++++++++ test/lisp/pcomplete-tests.el | 100 +++++++ 8 files changed, 1004 insertions(+), 24 deletions(-) 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..3584fa0673 --- /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 the Git status of a file. +Files listed by `git ls-files ARGS' satisfy the predicate." + (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 ((subcommands (pcomplete-from-help `(,vc-git-program "help" "-a") + :margin "^\\( +\\)[a-z]" + :argument "[[:alnum:]-]+"))) + (while (not (member (pcomplete-arg 1) subcommands)) + (if (string-prefix-p "-" (pcomplete-arg)) + (pcomplete-here (pcomplete-from-help `(,vc-git-program "help") + :margin "\\(\\[\\)-" + :separator " | " + :description "\\`")) + (pcomplete-here (completion-table-merge + subcommands + (when (string-prefix-p "-" (pcomplete-arg 1)) + (pcomplete-entries)))))) + (let ((subcmd (pcomplete-arg 1))) + (while (pcase subcmd + ((guard (string-prefix-p "-" (pcomplete-arg))) + (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..cdfde5640a 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -394,6 +394,40 @@ pcomplete/find (while (pcomplete-here (pcomplete-dirs) nil #'identity)))) ;;;###autoload -(defalias 'pcomplete/gdb 'pcomplete/xargs) +(defun pcomplete/awk () + "Completion for the `awk' command." + (pcomplete-here-using-help "awk --help" + :margin "\t" + :separator " +" + :description "\0" + :metavar "[=a-z]+")) + +;;;###autoload +(defun pcomplete/gpg () + "Completion for the `gpg` command." + (pcomplete-here-using-help "gpg --help" :narrow-end "^ -se")) + +;;;###autoload +(defun pcomplete/gdb () + "Completion for the `gdb' command." + (while + (cond + ((string= "--args" (pcomplete-arg 1)) + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + ((string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "gdb --help"))) + (t (pcomplete-here (pcomplete-entries)))))) + +;;;###autoload +(defun pcomplete/emacs () + "Completion for the `emacs' command." + (pcomplete-here-using-help "emacs --help" :margin "^\\(\\)-")) + +;;;###autoload +(defun pcomplete/emacsclient () + "Completion for the `emacsclient' command." + (pcomplete-here-using-help "emacsclient --help" :margin "^\\(\\)-")) ;;; pcmpl-gnu.el ends here diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 7c072f3d40..023c655a2a 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -30,6 +30,7 @@ (provide 'pcmpl-linux) (require 'pcomplete) +(eval-when-compile (require 'rx)) ;; Functions: @@ -111,4 +112,71 @@ pcmpl-linux-mountable-directories (pcomplete-uniquify-list points) (cons "swap" (pcmpl-linux-mounted-directories)))))) +;;; systemd + +(defun pcmpl-linux--systemd-units (&rest args) + "Run `systemd list-units ARGS' and return the output as a list." + (with-temp-buffer + (apply #'call-process + "systemctl" nil '(t nil) nil + "list-units" "--full" "--legend=no" "--plain" args) + (goto-char (point-min)) + (let (result) + (while (re-search-forward (rx bol (group (+ (not space))) + (+ space) (+ (not space)) + (+ space) (group (+ (not space))) + (+ space) (+ (not space)) + (+ space) (group (* nonl))) + nil t) + (push (match-string 1) result) + (put-text-property 0 1 'pcomplete-annotation + (concat " " (match-string 2)) + (car result)) + (put-text-property 0 1 'pcomplete-description + (match-string 3) + (car result))) + (nreverse result)))) + +;;;###autoload +(defun pcomplete/systemctl () + "Completion for the `systemctl' command." + (let ((subcmds (pcomplete-from-help + "systemctl --help" + :margin (rx bol " " (group) alpha) + :argument (rx (+ (any alpha ?-))) + :metavar (rx (group (+ " " (>= 2 (any upper "[]|.")))))))) + (while (not (member (pcomplete-arg 1) subcmds)) + (if (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "systemctl --help" + :metavar "[^ ]+" + :separator " \\(\\)-")) + (pcomplete-here subcmds))) + (let ((subcmd (pcomplete-arg 1)) + (context (if (member "--user" pcomplete-args) "--user" "--system"))) + (while (pcase subcmd + ((guard (string-prefix-p "-" (pcomplete-arg 0))) + (pcomplete-here + (pcomplete-from-help "systemctl --help"))) + ;; TODO: suggest only relevant units to each subcommand + ("start" + (pcomplete-here + (pcmpl-linux--systemd-units context "--state" "inactive,failed"))) + ((or "restart" "stop") + (pcomplete-here + (pcmpl-linux--systemd-units context "--state" "active"))) + (_ (pcomplete-here + (completion-table-in-turn + (pcmpl-linux--systemd-units context "--all") + (pcomplete-entries))))))))) + +;;;###autoload +(defun pcomplete/journalctl () + "Completion for the `journalctl' command." + (while (if (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "journalctl --help" + :metavar "[^ ]+" + :separator " \\(\\)-")) + (pcomplete-here (mapcar (lambda (s) (concat s "=")) + (process-lines "journalctl" "--fields")))))) + ;;; pcmpl-linux.el ends here diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index f7925d9d9e..ebb6b72600 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,46 @@ 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-unix.el b/lisp/pcmpl-unix.el index 8774f091c8..0c32f814d0 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -25,7 +25,7 @@ (require 'pcomplete) -;; User Variables: +;;; User Variables (defcustom pcmpl-unix-group-file "/etc/group" "If non-nil, a string naming the group file on your system." @@ -56,7 +56,7 @@ pcmpl-ssh-config-file :group 'pcmpl-unix :version "24.1") -;; Functions: +;;; Shell builtins and core utilities ;;;###autoload (defun pcomplete/cd () @@ -69,34 +69,38 @@ 'pcomplete/pushd ;;;###autoload (defun pcomplete/rmdir () "Completion for `rmdir'." - (while (pcomplete-here (pcomplete-dirs)))) + (while (if (string-prefix-p "-" (pcomplete-arg)) + (pcomplete-here (pcomplete-from-help "rmdir --help")) + (pcomplete-here (pcomplete-dirs))))) ;;;###autoload (defun pcomplete/rm () - "Completion for `rm'." - (let ((pcomplete-help "(fileutils)rm invocation")) - (pcomplete-opt "dfirRv") - (while (pcomplete-here (pcomplete-all-entries) nil - #'expand-file-name)))) + "Completion for the `rm' command." + (pcomplete-here-using-help "rm --help")) ;;;###autoload (defun pcomplete/xargs () "Completion for `xargs'." (while (string-prefix-p "-" (pcomplete-arg 0)) - (pcomplete-here (funcall pcomplete-default-completion-function))) + (pcomplete-here (pcomplete-from-help "xargs --help")) + (when (pcomplete-match "\\`-[adEIiLnPs]\\'") (pcomplete-here))) (funcall pcomplete-command-completion-function) (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) pcomplete-default-completion-function))) -;; FIXME: Add completion of sudo-specific arguments. -(defalias 'pcomplete/sudo #'pcomplete/xargs) - ;;;###autoload -(defalias 'pcomplete/time 'pcomplete/xargs) +(defun pcomplete/time () + "Completion for the `time' command." + (pcomplete-opt "p") + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) ;;;###autoload (defun pcomplete/which () "Completion for `which'." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "which --help"))) (while (pcomplete-here (funcall pcomplete-command-completion-function)))) (defun pcmpl-unix-read-passwd-file (file) @@ -128,25 +132,455 @@ pcmpl-unix-user-names (if pcmpl-unix-passwd-file (pcmpl-unix-read-passwd-file pcmpl-unix-passwd-file))) +;;;###autoload +(defun pcomplete/cat () + "Completion for the `cat' command." + (pcomplete-here-using-help "cat --help")) + +;;;###autoload +(defun pcomplete/tac () + "Completion for the `tac' command." + (pcomplete-here-using-help "tac --help")) + +;;;###autoload +(defun pcomplete/nl () + "Completion for the `nl' command." + (pcomplete-here-using-help "nl --help")) + +;;;###autoload +(defun pcomplete/od () + "Completion for the `od' command." + (pcomplete-here-using-help "od --help")) + +;;;###autoload +(defun pcomplete/base32 () + "Completion for the `base32' and `base64' commands." + (pcomplete-here-using-help "base32 --help")) +;;;###autoload +(defalias 'pcomplete/base64 'pcomplete/base32) + +;;;###autoload +(defun pcomplete/basenc () + "Completion for the `basenc' command." + (pcomplete-here-using-help "basenc --help")) + +;;;###autoload +(defun pcomplete/fmt () + "Completion for the `fmt' command." + (pcomplete-here-using-help "fmt --help")) + +;;;###autoload +(defun pcomplete/pr () + "Completion for the `pr' command." + (pcomplete-here-using-help "pr --help")) + +;;;###autoload +(defun pcomplete/fold () + "Completion for the `fold' command." + (pcomplete-here-using-help "fold --help")) + +;;;###autoload +(defun pcomplete/head () + "Completion for the `head' command." + (pcomplete-here-using-help "head --help")) + +;;;###autoload +(defun pcomplete/tail () + "Completion for the `tail' command." + (pcomplete-here-using-help "tail --help")) + +;;;###autoload +(defun pcomplete/split () + "Completion for the `split' command." + (pcomplete-here-using-help "split --help")) + +;;;###autoload +(defun pcomplete/csplit () + "Completion for the `csplit' command." + (pcomplete-here-using-help "csplit --help")) + +;;;###autoload +(defun pcomplete/wc () + "Completion for the `wc' command." + (pcomplete-here-using-help "wc --help")) + +;;;###autoload +(defun pcomplete/sum () + "Completion for the `sum' command." + (pcomplete-here-using-help "sum --help")) + +;;;###autoload +(defun pcomplete/cksum () + "Completion for the `cksum' command." + (pcomplete-here-using-help "cksum --help")) + +;;;###autoload +(defun pcomplete/b2sum () + "Completion for the `b2sum' command." + (pcomplete-here-using-help "b2sum --help")) + +;;;###autoload +(defun pcomplete/md5sum () + "Completion for checksum commands." + (pcomplete-here-using-help "md5sum --help")) +;;;###autoload(defalias 'pcomplete/sha1sum 'pcomplete/md5sum) +;;;###autoload(defalias 'pcomplete/sha224sum 'pcomplete/md5sum) +;;;###autoload(defalias 'pcomplete/sha256sum 'pcomplete/md5sum) +;;;###autoload(defalias 'pcomplete/sha384sum 'pcomplete/md5sum) +;;;###autoload(defalias 'pcomplete/sha521sum 'pcomplete/md5sum) + +;;;###autoload +(defun pcomplete/sort () + "Completion for the `sort' command." + (pcomplete-here-using-help "sort --help")) + +;;;###autoload +(defun pcomplete/shuf () + "Completion for the `shuf' command." + (pcomplete-here-using-help "shuf --help")) + +;;;###autoload +(defun pcomplete/uniq () + "Completion for the `uniq' command." + (pcomplete-here-using-help "uniq --help")) + +;;;###autoload +(defun pcomplete/comm () + "Completion for the `comm' command." + (pcomplete-here-using-help "comm --help")) + +;;;###autoload +(defun pcomplete/ptx () + "Completion for the `ptx' command." + (pcomplete-here-using-help "ptx --help")) + +;;;###autoload +(defun pcomplete/tsort () + "Completion for the `tsort' command." + (pcomplete-here-using-help "tsort --help")) + +;;;###autoload +(defun pcomplete/cut () + "Completion for the `cut' command." + (pcomplete-here-using-help "cut --help")) + +;;;###autoload +(defun pcomplete/paste () + "Completion for the `paste' command." + (pcomplete-here-using-help "paste --help")) + +;;;###autoload +(defun pcomplete/join () + "Completion for the `join' command." + (pcomplete-here-using-help "join --help")) + +;;;###autoload +(defun pcomplete/tr () + "Completion for the `tr' command." + (pcomplete-here-using-help "tr --help")) + +;;;###autoload +(defun pcomplete/expand () + "Completion for the `expand' command." + (pcomplete-here-using-help "expand --help")) + +;;;###autoload +(defun pcomplete/unexpand () + "Completion for the `unexpand' command." + (pcomplete-here-using-help "unexpand --help")) + +;;;###autoload +(defun pcomplete/ls () + "Completion for the `ls' command." + (pcomplete-here-using-help "ls --help")) +;;;###autoload(defalias 'pcomplete/dir 'pcomplete/ls) +;;;###autoload(defalias 'pcomplete/vdir 'pcomplete/ls) + +;;;###autoload +(defun pcomplete/cp () + "Completion for the `cp' command." + (pcomplete-here-using-help "cp --help")) + +;;;###autoload +(defun pcomplete/dd () + "Completion for the `dd' command." + (let ((operands (pcomplete-from-help "dd --help" + :argument "[a-z]+=" + :narrow-start "\n\n" + :narrow-end "\n\n"))) + (while + (cond ((pcomplete-match "\\`[io]f=\\(.*\\)" 0) + (pcomplete-here (pcomplete-entries) + (pcomplete-match-string 1 0))) + (t (pcomplete-here operands)))))) + +;;;###autoload +(defun pcomplete/install () + "Completion for the `install' command." + (pcomplete-here-using-help "install --help")) + +;;;###autoload +(defun pcomplete/mv () + "Completion for the `mv' command." + (pcomplete-here-using-help "mv --help")) + +;;;###autoload +(defun pcomplete/shred () + "Completion for the `shred' command." + (pcomplete-here-using-help "shred --help")) + +;;;###autoload +(defun pcomplete/ln () + "Completion for the `ln' command." + (pcomplete-here-using-help "ln --help")) + +;;;###autoload +(defun pcomplete/mkdir () + "Completion for the `mkdir' command." + (pcomplete-here-using-help "mkdir --help")) + +;;;###autoload +(defun pcomplete/mkfifo () + "Completion for the `mkfifo' command." + (pcomplete-here-using-help "mkfifo --help")) + +;;;###autoload +(defun pcomplete/mknod () + "Completion for the `mknod' command." + (pcomplete-here-using-help "mknod --help")) + +;;;###autoload +(defun pcomplete/readlink () + "Completion for the `readlink' command." + (pcomplete-here-using-help "readlink --help")) + ;;;###autoload (defun pcomplete/chown () "Completion for the `chown' command." - (unless (pcomplete-match "\\`-") - (if (pcomplete-match "\\`[^.]*\\'" 0) - (pcomplete-here* (pcmpl-unix-user-names)) - (if (pcomplete-match "\\.\\([^.]*\\)\\'" 0) - (pcomplete-here* (pcmpl-unix-group-names) - (pcomplete-match-string 1 0)) - (pcomplete-here*)))) + (while (pcomplete-match "\\`-" 0) + (pcomplete-here (pcomplete-from-help "chown --help"))) + (if (pcomplete-match "\\`[^.]*\\'" 0) + (pcomplete-here* (pcmpl-unix-user-names)) + (if (pcomplete-match "\\.\\([^.]*\\)\\'" 0) + (pcomplete-here* (pcmpl-unix-group-names) + (pcomplete-match-string 1 0)) + (pcomplete-here*))) (while (pcomplete-here (pcomplete-entries)))) ;;;###autoload (defun pcomplete/chgrp () "Completion for the `chgrp' command." - (unless (pcomplete-match "\\`-") - (pcomplete-here* (pcmpl-unix-group-names))) + (while (pcomplete-match "\\`-" 0) + (pcomplete-here (pcomplete-from-help "chgrp --help"))) + (pcomplete-here* (pcmpl-unix-group-names)) (while (pcomplete-here (pcomplete-entries)))) +;;;###autoload +(defun pcomplete/chmod () + "Completion for the `chmod' command." + (pcomplete-here-using-help "chmod --help")) + +;;;###autoload +(defun pcomplete/touch () + "Completion for the `touch' command." + (pcomplete-here-using-help "touch --help")) + +;;;###autoload +(defun pcomplete/df () + "Completion for the `df' command." + (pcomplete-here-using-help "df --help")) + +;;;###autoload +(defun pcomplete/du () + "Completion for the `du' command." + (pcomplete-here-using-help "du --help")) + +;;;###autoload +(defun pcomplete/stat () + "Completion for the `stat' command." + (pcomplete-here-using-help "stat --help")) + +;;;###autoload +(defun pcomplete/sync () + "Completion for the `sync' command." + (pcomplete-here-using-help "sync --help")) + +;;;###autoload +(defun pcomplete/truncate () + "Completion for the `truncate' command." + (pcomplete-here-using-help "truncate --help")) + +;;;###autoload +(defun pcomplete/echo () + "Completion for the `echo' command." + (pcomplete-here-using-help '("echo" "--help"))) + +;;;###autoload +(defun pcomplete/test () + "Completion for the `test' command." + (pcomplete-here-using-help '("[" "--help") + :margin "^ +\\([A-Z]+1 \\)?")) +;;;###autoload(defalias (intern "pcomplete/[") 'pcomplete/test) + +;;;###autoload +(defun pcomplete/tee () + "Completion for the `tee' command." + (pcomplete-here-using-help "tee --help")) + +;;;###autoload +(defun pcomplete/basename () + "Completion for the `basename' command." + (pcomplete-here-using-help "basename --help")) + +;;;###autoload +(defun pcomplete/dirname () + "Completion for the `dirname' command." + (pcomplete-here-using-help "dirname --help")) + +;;;###autoload +(defun pcomplete/pathchk () + "Completion for the `pathchk' command." + (pcomplete-here-using-help "pathchk --help")) + +;;;###autoload +(defun pcomplete/mktemp () + "Completion for the `mktemp' command." + (pcomplete-here-using-help "mktemp --help")) + +;;;###autoload +(defun pcomplete/realpath () + "Completion for the `realpath' command." + (pcomplete-here-using-help "realpath --help")) + +;;;###autoload +(defun pcomplete/id () + "Completion for the `id' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "id --help"))) + (while (pcomplete-here (pcmpl-unix-user-names)))) + +;;;###autoload +(defun pcomplete/groups () + "Completion for the `groups' command." + (while (pcomplete-here (pcmpl-unix-user-names)))) + +;;;###autoload +(defun pcomplete/who () + "Completion for the `who' command." + (pcomplete-here-using-help "who --help")) + +;;;###autoload +(defun pcomplete/date () + "Completion for the `date' command." + (pcomplete-here-using-help "date --help")) + +;;;###autoload +(defun pcomplete/nproc () + "Completion for the `nproc' command." + (pcomplete-here-using-help "nproc --help")) + +;;;###autoload +(defun pcomplete/uname () + "Completion for the `uname' command." + (pcomplete-here-using-help "uname --help")) + +;;;###autoload +(defun pcomplete/hostname () + "Completion for the `hostname' command." + (pcomplete-here-using-help "hostname --help")) + +;;;###autoload +(defun pcomplete/uptime () + "Completion for the `uptime' command." + (pcomplete-here-using-help "uptime --help")) + +;;;###autoload +(defun pcomplete/chcon () + "Completion for the `chcon' command." + (pcomplete-here-using-help "chcon --help")) + +;;;###autoload +(defun pcomplete/runcon () + "Completion for the `runcon' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "runcon --help")) + (when (pcomplete-match "\\`-[turl]\\'" 0) (pcomplete-here))) + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + +;;;###autoload +(defun pcomplete/chroot () + "Completion for the `chroot' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "chroot --help"))) + (pcomplete-here (pcomplete-dirs)) + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + +;;;###autoload +(defun pcomplete/env () + "Completion for the `env' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "env --help")) + (when (pcomplete-match "\\`-[uCS]\\'") (pcomplete-here))) + (while (pcomplete-match "=" 0) (pcomplete-here)) ; FIXME: Complete env vars + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + +;;;###autoload +(defun pcomplete/nice () + "Completion for the `nice' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "nice --help")) + (pcomplete-here)) + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + +;;;###autoload +(defun pcomplete/nohup () + "Completion for the `nohup' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "nohup --help"))) + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + +;;;###autoload +(defun pcomplete/stdbuf () + "Completion for the `stdbuf' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "stdbuf --help")) + (when (pcomplete-match "\\`-[ioe]\\'") (pcomplete-here))) + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + +;;;###autoload +(defun pcomplete/timeout () + "Completion for the `timeout' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "timeout --help")) + (when (pcomplete-match "\\`-[ks]\\'") (pcomplete-here))) + (pcomplete-here) ; eat DURATION argument + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + +;;;###autoload +(defun pcomplete/numfmt () + "Completion for the `numfmt' command." + (pcomplete-here-using-help "numfmt --help")) + +;;;###autoload +(defun pcomplete/seq () + "Completion for the `seq' command." + (pcomplete-here-using-help "seq --help")) + +;;; Network commands ;; ssh support by Phil Hagelberg. ;; https://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el @@ -239,6 +673,18 @@ pcomplete/telnet (pcomplete-opt "xl(pcmpl-unix-user-names)") (pcmpl-unix-complete-hostname)) +;;; Miscellaneous + +;;;###autoload +(defun pcomplete/sudo () + "Completion for the `sudo' command." + (while (string-prefix-p "-" (pcomplete-arg 0)) + (pcomplete-here (pcomplete-from-help "sudo --help")) + (when (pcomplete-match "\\`-[CDghpRtTUu]\\'") (pcomplete-here))) + (funcall pcomplete-command-completion-function) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + (provide 'pcmpl-unix) ;;; pcmpl-unix.el ends here diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 261a3d4e27..1ede867c5f 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -28,6 +28,22 @@ (eval-when-compile (require 'cl-lib)) (require 'pcomplete) +;;; TeX + +;;;###autoload +(defun pcomplete/tex () + "Completion for the `tex' command." + (pcomplete-here-using-help "tex --help" + :margin "^\\(?:\\[-no\\]\\)?\\(\\)-")) +;;;###autoload(defalias 'pcomplete/pdftex 'pcomplete/tex) +;;;###autoload(defalias 'pcomplete/latex 'pcomplete/tex) +;;;###autoload(defalias 'pcomplete/pdflatex 'pcomplete/tex) + +;;;###autoload +(defun pcomplete/luatex () + "Completion for the `luatex' command." + (pcomplete-here-using-help "luatex --help")) +;;;###autoload(defalias 'pcomplete/lualatex 'pcomplete/luatex) ;;;; tlmgr - https://www.tug.org/texlive/tlmgr.html @@ -142,6 +158,12 @@ pcomplete/tlmgr (unless (pcomplete-match "^--" 0) (pcomplete-here* (pcomplete-dirs-or-entries))))))) +;;; Grep-like tools + +;;;###autoload +(defun pcomplete/rg () + "Completion for the `rg' command." + (pcomplete-here-using-help "rg --help")) ;;;; ack - https://betterthangrep.com @@ -288,6 +310,8 @@ pcomplete/ag (pcmpl-x-ag-options)))) (pcomplete-here* (pcomplete-dirs-or-entries))))) +;;; Borland + ;;;###autoload (defun pcomplete/bcc32 () "Completion function for Borland's C++ compiler." @@ -321,5 +345,24 @@ pcomplete/bcc32 ;;;###autoload (defalias 'pcomplete/bcc 'pcomplete/bcc32) +;;; Network tools + +;;;###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 0e3d1df781..6fe29d9dcf 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 @@ 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. @@ -1325,6 +1336,133 @@ 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 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 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 --=-=-= Content-Type: text/plain > > [...] > >> + ("start" >> + (pcomplete-here >> + (pcmpl-linux--systemd-units context "--state" "inactive,failed"))) >> + ((or "restart" "stop") >> + (pcomplete-here >> + (pcmpl-linux--systemd-units context "--state" "active"))) > > But... subcmd isn't used here in the new lines, either, so does that > really fix the warning? `subcmd' was always there, textually, in the `(pcase subcmd' right above that. But in the previous version of the code it disappeared during macro expansion because it was not compared against anything in the pcase patterns. Very neat sanity check, indeed (but I did what I did on purpose because I wanted to leave the function in an easier shape for future refinements). >> Hum, I don't know how to fix this. The long line is the function >> signature, which is created mechanically by cl-defun and displays all >> the default values of the keyword arguments. >> >> The formatting is horrible: >> >> (pcomplete-from-help COMMAND &rest ARGS &key (MARGIN (rx bol (+ " "))) >> (ARGUMENT (rx "-" (+ (any "-" alnum)) (32 "="))) (METAVAR (rx (32 " ") >> (or (+ (any alnum "_-")) (seq "[" (+? nonl) "]") (seq "<" (+? nonl) >> ">") (seq "{" (+? nonl) "}")))) (SEPARATOR (rx ", " symbol-start)) >> (DESCRIPTION (rx (* nonl) (* "\n" (>= 9 " ") (* nonl)))) NARROW-START >> NARROW-END) >> >> But the information is good to have, because you need to know what these >> regexps are in order to use the function. > > Oh, yeah, that's pretty bad... we should probably fix that in the > cl-defun macro, I guess, so this doesn't have to be fixed in this patch. All right, thanks. --=-=-=--