[Emacs-diffs] /srv/bzr/emacs/trunk r105982: * lisp/pcmpl-gnu.el (pcmpl-gnu-with-file-buffer): New macro.

[Stefan Monnier]

------------------------------------------------------------
revno: 105982
fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9643
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sat 2011-10-01 21:00:17 -0400
message:
  * lisp/pcmpl-gnu.el (pcmpl-gnu-with-file-buffer): New macro.
  (pcmpl-gnu-tar-buffer): Remove.
  (pcmpl-gnu-with-file-buffer): Use it to avoid leaving the tar's buffer
  avoid.  Make sure pcomplete-suffix-list is only changed temporarily.
  Don't look inside the tar's file is it's too large.
modified:
  lisp/ChangeLog
  lisp/pcmpl-gnu.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-10-02 00:25:27 +0000
+++ b/lisp/ChangeLog    2011-10-02 01:00:17 +0000
@@ -1,3 +1,11 @@
+2011-10-02  Stefan Monnier  <address@hidden>
+
+       * pcmpl-gnu.el (pcmpl-gnu-with-file-buffer): New macro (bug#9643).
+       (pcmpl-gnu-tar-buffer): Remove.
+       (pcmpl-gnu-with-file-buffer): Use it to avoid leaving the tar's buffer
+       avoid.  Make sure pcomplete-suffix-list is only changed temporarily.
+       Don't look inside the tar's file is it's too large.
+
 2011-10-01  Chong Yidong  <address@hidden>
 
        * cus-edit.el (custom-mode-map):

=== modified file 'lisp/pcmpl-gnu.el'
--- a/lisp/pcmpl-gnu.el 2011-10-01 02:38:46 +0000
+++ b/lisp/pcmpl-gnu.el 2011-10-02 01:00:17 +0000
@@ -128,161 +128,174 @@
   :type 'regexp
   :group 'pcmpl-gnu)
 
-(defvar pcmpl-gnu-tar-buffer nil)
-
 ;; Only used in tar-mode buffers.
 (defvar tar-parse-info)
 (declare-function tar-header-name "tar-mode" t t)
 
+(defmacro pcmpl-gnu-with-file-buffer (file &rest body)
+  "Run BODY inside a buffer visiting FILE."
+  (declare (debug t) (indent 1))
+  (let ((exist (make-symbol "exist"))
+        (filesym (make-symbol "file"))
+        (buf (make-symbol "buf")))
+    `(let* ((,filesym ,file)
+            (,exist (find-buffer-visiting ,filesym))
+            (,buf (or ,exist (find-file-noselect ,filesym))))
+       (unwind-protect
+           (with-current-buffer ,buf
+             ,@body)
+         (when (and (not ,exist) (buffer-live-p ,buf))
+           (kill-buffer ,buf))))))
+
 ;;;###autoload
 (defun pcomplete/tar ()
   "Completion for the GNU tar utility."
   ;; options that end in an equal sign will want further completion...
   (let (saw-option complete-within)
-    (setq 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)
-             (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
-       ((pcomplete-match "\\`--after-date=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--backup=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--blocking-factor=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--directory=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-dirs)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-entries)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--exclude=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0)
-       (setq complete-within t))
-       ((pcomplete-match "\\`--file=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--files-from=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-entries)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--group=\\(.*\\)" 0)
-       (pcomplete-here* (pcmpl-unix-group-names)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--info-script=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-entries)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--label=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--mode=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-entries)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--newer=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--owner=\\(.*\\)" 0)
-       (pcomplete-here* (pcmpl-unix-user-names)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--record-size=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0)
-       (pcomplete-here* (funcall pcomplete-command-completion-function)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-entries)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--suffix=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--tape-length=" 0)
-       (pcomplete-here*))
-       ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0)
-       (pcomplete-here* (funcall pcomplete-command-completion-function)
-                        (pcomplete-match-string 1 0)))
-       ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0)
-       (pcomplete-here* (pcomplete-entries)
-                        (pcomplete-match-string 1 0)))))
-    (setq pcomplete-suffix-list (cdr pcomplete-suffix-list))
+    (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
+         ((pcomplete-match "\\`--after-date=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--backup=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--blocking-factor=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--directory=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-dirs)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-entries)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--exclude=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0)
+          (setq complete-within t))
+         ((pcomplete-match "\\`--file=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--files-from=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-entries)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--group=\\(.*\\)" 0)
+          (pcomplete-here* (pcmpl-unix-group-names)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--info-script=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-entries)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--label=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--mode=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-entries)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--newer=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--owner=\\(.*\\)" 0)
+          (pcomplete-here* (pcmpl-unix-user-names)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--record-size=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0)
+          (pcomplete-here* (funcall pcomplete-command-completion-function)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-entries)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--suffix=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--tape-length=" 0)
+          (pcomplete-here*))
+         ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0)
+          (pcomplete-here* (funcall pcomplete-command-completion-function)
+                           (pcomplete-match-string 1 0)))
+         ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0)
+          (pcomplete-here* (pcomplete-entries)
+                           (pcomplete-match-string 1 0))))))
     (unless saw-option
       (pcomplete-here
        (mapcar 'char-to-string
@@ -291,15 +304,16 @@
       (if (pcomplete-match "[xt]" 'first 1)
          (setq complete-within t)))
     (pcomplete-here (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp))
-    (setq pcmpl-gnu-tar-buffer (find-file-noselect (pcomplete-arg 1)))
     (while (pcomplete-here
-           (if complete-within
-               (with-current-buffer pcmpl-gnu-tar-buffer
-                 (mapcar
-                  (function
-                   (lambda (entry)
-                     (tar-header-name entry)))
-                  tar-parse-info))
+           (if (and complete-within
+                     (let* ((fa (file-attributes (pcomplete-arg 1)))
+                            (size (nth 7 fa)))
+                       (and (numberp size)
+                            (< size large-file-warning-threshold))))
+                (completion-table-dynamic
+                 (lambda (string)
+                   (pcmpl-gnu-with-file-buffer (pcomplete-arg 1)
+                     (mapcar #'tar-header-name tar-parse-info))))
              (pcomplete-entries))
            nil 'identity))))