bug#10457: (Broken?) programmable completion in shell buffers

[Thierry Volpiatto]

Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:

> Stefan Monnier <monnier@IRO.UMontreal.CA> writes:
>
>>> Second, more disturbingly, trying to complete options to "tar" locks Emacs.
>>> Here is how to reproduce it:
>>
>>> emacs -Q
>>> M-x shell
>>> cd <some directory without dashes in file and directory names>
>>> tar - TAB SPC
>>
>> I believe I've fixed this bug "recently".
>
> It seem this is not fixed, i can reproduce the bug here.

This seem to work as expected, not hanging at least, and completing
against long and short opts and then filenames.

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1326107014 -3600
# Node ID 10a15a1251fd3e4ba77eb3e2b35a5bf4c4c50ed2
# Parent  2175cc538ceea5e0b7395e8be10c884b02386d1d
"New patch"

diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -152,6 +152,20 @@
          (when (and (not ,exist) (buffer-live-p ,buf))
            (kill-buffer ,buf))))))
 
+
+(defun eshell-collect-tar-long-opts ()
+  (with-temp-buffer
+    (call-process "tar" nil (current-buffer) nil "--help")
+    (goto-char (point-min))
+    (loop with lo while
+          (re-search-forward "^\\( *-[a-zA-Z0-9], --[a-zA-Z0-9-]*=?\\)\
+\\|\\( *--[a-zA-Z0-9-]*=?\\)" nil t)
+          for opts = (split-string (match-string 0) ",")
+          append (loop for i in (if (> (length opts) 1) (cdr opts) opts)
+                       for op = (replace-regexp-in-string " " "" i)
+                       unless (member op lo)
+                       do (push op lo) and collect op))))
+
 ;;;###autoload
 (defun pcomplete/tar ()
   "Completion for the GNU tar utility."
@@ -160,89 +174,10 @@
     (let ((pcomplete-suffix-list (cons ?= pcomplete-suffix-list)))
       (while (pcomplete-match "^-" 0)
         (setq saw-option t)
-        (if (pcomplete-match "^--" 0)
-            (if (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0)
-                ;; FIXME: Extract this list from "tar --help".
-                (pcomplete-here*
-                 '("--absolute-names"
-                   "--after-date="
-                   "--append"
-                   "--atime-preserve"
-                   "--backup"
-                   "--block-number"
-                   "--blocking-factor="
-                   "--catenate"
-                   "--checkpoint"
-                   "--compare"
-                   "--compress"
-                   "--concatenate"
-                   "--confirmation"
-                   "--create"
-                   "--delete"
-                   "--dereference"
-                   "--diff"
-                   "--directory="
-                   "--exclude="
-                   "--exclude-from="
-                   "--extract"
-                   "--file="
-                   "--files-from="
-                   "--force-local"
-                   "--get"
-                   "--group="
-                   "--gzip"
-                   "--help"
-                   "--ignore-failed-read"
-                   "--ignore-zeros"
-                   "--incremental"
-                   "--info-script="
-                   "--interactive"
-                   "--keep-old-files"
-                   "--label="
-                   "--list"
-                   "--listed-incremental"
-                   "--mode="
-                   "--modification-time"
-                   "--multi-volume"
-                   "--new-volume-script="
-                   "--newer="
-                   "--newer-mtime"
-                   "--no-recursion"
-                   "--null"
-                   "--numeric-owner"
-                   "--old-archive"
-                   "--one-file-system"
-                   "--owner="
-                   "--portability"
-                   "--posix"
-                   "--preserve"
-                   "--preserve-order"
-                   "--preserve-permissions"
-                   "--read-full-records"
-                   "--record-size="
-                   "--recursive-unlink"
-                   "--remove-files"
-                   "--rsh-command="
-                   "--same-order"
-                   "--same-owner"
-                   "--same-permissions"
-                   "--sparse"
-                   "--starting-file="
-                   "--suffix="
-                   "--tape-length="
-                   "--to-stdout"
-                   "--totals"
-                   "--uncompress"
-                   "--ungzip"
-                   "--unlink-first"
-                   "--update"
-                   "--use-compress-program="
-                   "--verbose"
-                   "--verify"
-                   "--version"
-                   "--volno-file=")))
-          (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz"))
         (cond
+         ((and (pcomplete-match "^--" 0)
+               (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0))
+          (pcomplete-here* (eshell-collect-tar-long-opts)))
          ((pcomplete-match "\\`--after-date=" 0)
           (pcomplete-here*))
          ((pcomplete-match "\\`--backup=" 0)
@@ -300,14 +235,16 @@
                            (pcomplete-match-string 1 0)))
          ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0)
           (pcomplete-here* (pcomplete-entries)
-                           (pcomplete-match-string 1 0))))))
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "^-\\([^= \t\n\f]*\\)\\'" 0)
+          (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")))))
     (unless saw-option
       (pcomplete-here
        (mapcar 'char-to-string
               (string-to-list
                "01234567ABCFGIKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")))
-      (if (pcomplete-match "[xt]" 'first 1)
-         (setq complete-within t)))
+      (when (pcomplete-match "[xt]" 'first 1)
+        (setq complete-within t)))
     (pcomplete-here (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp))
     (while (pcomplete-here
            (if (and complete-within
@@ -320,10 +257,11 @@
                   (completion-table-dynamic
                    (lambda (_string)
                      (pcmpl-gnu-with-file-buffer file
-                       (mapcar #'tar-header-name tar-parse-info)))))
-             (pcomplete-entries))
+                                                 (mapcar #'tar-header-name 
tar-parse-info)))))
+              (pcomplete-entries))
            nil 'identity))))
 
+
 ;;;###autoload
 (defalias 'pcomplete/gdb 'pcomplete/xargs)
 
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -981,54 +981,56 @@
 the argument appear after a ganged set of options.  This is how tar
 behaves, for example.
 Arguments NO-GANGING and ARGS-FOLLOW are currently ignored."
-  (if (and (= pcomplete-index pcomplete-last)
-          (string= (pcomplete-arg) "-"))
-      (let ((len (length options))
-           (index 0)
-           char choices)
-       (while (< index len)
-         (setq char (aref options index))
-         (if (eq char ?\()
-             (let ((result (read-from-string options index)))
-               (setq index (cdr result)))
-           (unless (memq char '(?/ ?* ?? ?.))
-             (push (char-to-string char) choices))
-           (setq index (1+ index))))
-       (throw 'pcomplete-completions
-              (mapcar
-               (function
-                (lambda (opt)
-                  (concat "-" opt)))
-               (pcomplete-uniqify-list choices))))
-    (let ((arg (pcomplete-arg)))
-      (when (and (> (length arg) 1)
-                (stringp arg)
-                (eq (aref arg 0) (or prefix ?-)))
-       (pcomplete-next-arg)
-       (let ((char (aref arg 1))
-             (len (length options))
-             (index 0)
-             opt-char arg-char result)
-         (while (< (1+ index) len)
-           (setq opt-char (aref options index)
-                 arg-char (aref options (1+ index)))
-           (if (eq arg-char ?\()
-               (setq result
-                     (read-from-string options (1+ index))
-                     index (cdr result)
-                     result (car result))
-             (setq result nil))
-           (when (and (eq char opt-char)
-                      (memq arg-char '(?\( ?/ ?* ?? ?.)))
-             (if (< pcomplete-index pcomplete-last)
-                 (pcomplete-next-arg)
-               (throw 'pcomplete-completions
-                      (cond ((eq arg-char ?/) (pcomplete-dirs))
-                            ((eq arg-char ?*) (pcomplete-executables))
-                            ((eq arg-char ??) nil)
-                            ((eq arg-char ?.) (pcomplete-entries))
-                            ((eq arg-char ?\() (eval result))))))
-           (setq index (1+ index))))))))
+  (or
+   (if (and (= pcomplete-index pcomplete-last)
+            (string= (pcomplete-arg) "-"))
+       (let ((len (length options))
+             (index 0)
+             char choices)
+         (while (< index len)
+           (setq char (aref options index))
+           (if (eq char ?\()
+               (let ((result (read-from-string options index)))
+                 (setq index (cdr result)))
+             (unless (memq char '(?/ ?* ?? ?.))
+               (push (char-to-string char) choices))
+             (setq index (1+ index))))
+         (throw 'pcomplete-completions
+                (mapcar
+                 (function
+                  (lambda (opt)
+                    (concat "-" opt)))
+                 (pcomplete-uniqify-list choices))))
+     (let ((arg (pcomplete-arg)))
+       (when (and (> (length arg) 1)
+                  (stringp arg)
+                  (eq (aref arg 0) (or prefix ?-)))
+         (pcomplete-next-arg)
+         (let ((char (aref arg 1))
+               (len (length options))
+               (index 0)
+               opt-char arg-char result)
+           (while (< (1+ index) len)
+             (setq opt-char (aref options index)
+                   arg-char (aref options (1+ index)))
+             (if (eq arg-char ?\()
+                 (setq result
+                       (read-from-string options (1+ index))
+                       index (cdr result)
+                       result (car result))
+               (setq result nil))
+             (when (and (eq char opt-char)
+                        (memq arg-char '(?\( ?/ ?* ?? ?.)))
+               (if (< pcomplete-index pcomplete-last)
+                   (pcomplete-next-arg)
+                 (throw 'pcomplete-completions
+                        (cond ((eq arg-char ?/) (pcomplete-dirs))
+                              ((eq arg-char ?*) (pcomplete-executables))
+                              ((eq arg-char ??) nil)
+                              ((eq arg-char ?.) (pcomplete-entries))
+                              ((eq arg-char ?\() (eval result))))))
+             (setq index (1+ index)))))))
+   (throw 'pcomplete-completions nil)))
 
 (defun pcomplete--here (&optional form stub paring form-only)
   "Complete against the current argument, if at the end.

-- 
  Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997