aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-10-01 21:00:17 -0400
committerStefan Monnier2011-10-01 21:00:17 -0400
commit428fe61ade6439cd2346f2586f56a4cabb8af287 (patch)
treea4cfd20ba1ad5dd034779c7891623ae378dca748
parent51553db66b4eb8bc7a0d1a1c3206e097e0cc94fa (diff)
downloademacs-428fe61ade6439cd2346f2586f56a4cabb8af287.tar.gz
emacs-428fe61ade6439cd2346f2586f56a4cabb8af287.zip
* 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. Fixes: debbugs:9643
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/pcmpl-gnu.el322
2 files changed, 176 insertions, 154 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4fcca274b06..f170cbd37c5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12011-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * pcmpl-gnu.el (pcmpl-gnu-with-file-buffer): New macro (bug#9643).
4 (pcmpl-gnu-tar-buffer): Remove.
5 (pcmpl-gnu-with-file-buffer): Use it to avoid leaving the tar's buffer
6 avoid. Make sure pcomplete-suffix-list is only changed temporarily.
7 Don't look inside the tar's file is it's too large.
8
12011-10-01 Chong Yidong <cyd@stupidchicken.com> 92011-10-01 Chong Yidong <cyd@stupidchicken.com>
2 10
3 * cus-edit.el (custom-mode-map): 11 * cus-edit.el (custom-mode-map):
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index 6bc4f7625bb..444b5ca59bb 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -128,161 +128,174 @@
128 :type 'regexp 128 :type 'regexp
129 :group 'pcmpl-gnu) 129 :group 'pcmpl-gnu)
130 130
131(defvar pcmpl-gnu-tar-buffer nil)
132
133;; Only used in tar-mode buffers. 131;; Only used in tar-mode buffers.
134(defvar tar-parse-info) 132(defvar tar-parse-info)
135(declare-function tar-header-name "tar-mode" t t) 133(declare-function tar-header-name "tar-mode" t t)
136 134
135(defmacro pcmpl-gnu-with-file-buffer (file &rest body)
136 "Run BODY inside a buffer visiting FILE."
137 (declare (debug t) (indent 1))
138 (let ((exist (make-symbol "exist"))
139 (filesym (make-symbol "file"))
140 (buf (make-symbol "buf")))
141 `(let* ((,filesym ,file)
142 (,exist (find-buffer-visiting ,filesym))
143 (,buf (or ,exist (find-file-noselect ,filesym))))
144 (unwind-protect
145 (with-current-buffer ,buf
146 ,@body)
147 (when (and (not ,exist) (buffer-live-p ,buf))
148 (kill-buffer ,buf))))))
149
137;;;###autoload 150;;;###autoload
138(defun pcomplete/tar () 151(defun pcomplete/tar ()
139 "Completion for the GNU tar utility." 152 "Completion for the GNU tar utility."
140 ;; options that end in an equal sign will want further completion... 153 ;; options that end in an equal sign will want further completion...
141 (let (saw-option complete-within) 154 (let (saw-option complete-within)
142 (setq pcomplete-suffix-list (cons ?= pcomplete-suffix-list)) 155 (let ((pcomplete-suffix-list (cons ?= pcomplete-suffix-list)))
143 (while (pcomplete-match "^-" 0) 156 (while (pcomplete-match "^-" 0)
144 (setq saw-option t) 157 (setq saw-option t)
145 (if (pcomplete-match "^--" 0) 158 (if (pcomplete-match "^--" 0)
146 (if (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0) 159 (if (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0)
147 (pcomplete-here* 160 ;; FIXME: Extract this list from "tar --help".
148 '("--absolute-names" 161 (pcomplete-here*
149 "--after-date=" 162 '("--absolute-names"
150 "--append" 163 "--after-date="
151 "--atime-preserve" 164 "--append"
152 "--backup" 165 "--atime-preserve"
153 "--block-number" 166 "--backup"
154 "--blocking-factor=" 167 "--block-number"
155 "--catenate" 168 "--blocking-factor="
156 "--checkpoint" 169 "--catenate"
157 "--compare" 170 "--checkpoint"
158 "--compress" 171 "--compare"
159 "--concatenate" 172 "--compress"
160 "--confirmation" 173 "--concatenate"
161 "--create" 174 "--confirmation"
162 "--delete" 175 "--create"
163 "--dereference" 176 "--delete"
164 "--diff" 177 "--dereference"
165 "--directory=" 178 "--diff"
166 "--exclude=" 179 "--directory="
167 "--exclude-from=" 180 "--exclude="
168 "--extract" 181 "--exclude-from="
169 "--file=" 182 "--extract"
170 "--files-from=" 183 "--file="
171 "--force-local" 184 "--files-from="
172 "--get" 185 "--force-local"
173 "--group=" 186 "--get"
174 "--gzip" 187 "--group="
175 "--help" 188 "--gzip"
176 "--ignore-failed-read" 189 "--help"
177 "--ignore-zeros" 190 "--ignore-failed-read"
178 "--incremental" 191 "--ignore-zeros"
179 "--info-script=" 192 "--incremental"
180 "--interactive" 193 "--info-script="
181 "--keep-old-files" 194 "--interactive"
182 "--label=" 195 "--keep-old-files"
183 "--list" 196 "--label="
184 "--listed-incremental" 197 "--list"
185 "--mode=" 198 "--listed-incremental"
186 "--modification-time" 199 "--mode="
187 "--multi-volume" 200 "--modification-time"
188 "--new-volume-script=" 201 "--multi-volume"
189 "--newer=" 202 "--new-volume-script="
190 "--newer-mtime" 203 "--newer="
191 "--no-recursion" 204 "--newer-mtime"
192 "--null" 205 "--no-recursion"
193 "--numeric-owner" 206 "--null"
194 "--old-archive" 207 "--numeric-owner"
195 "--one-file-system" 208 "--old-archive"
196 "--owner=" 209 "--one-file-system"
197 "--portability" 210 "--owner="
198 "--posix" 211 "--portability"
199 "--preserve" 212 "--posix"
200 "--preserve-order" 213 "--preserve"
201 "--preserve-permissions" 214 "--preserve-order"
202 "--read-full-records" 215 "--preserve-permissions"
203 "--record-size=" 216 "--read-full-records"
204 "--recursive-unlink" 217 "--record-size="
205 "--remove-files" 218 "--recursive-unlink"
206 "--rsh-command=" 219 "--remove-files"
207 "--same-order" 220 "--rsh-command="
208 "--same-owner" 221 "--same-order"
209 "--same-permissions" 222 "--same-owner"
210 "--sparse" 223 "--same-permissions"
211 "--starting-file=" 224 "--sparse"
212 "--suffix=" 225 "--starting-file="
213 "--tape-length=" 226 "--suffix="
214 "--to-stdout" 227 "--tape-length="
215 "--totals" 228 "--to-stdout"
216 "--uncompress" 229 "--totals"
217 "--ungzip" 230 "--uncompress"
218 "--unlink-first" 231 "--ungzip"
219 "--update" 232 "--unlink-first"
220 "--use-compress-program=" 233 "--update"
221 "--verbose" 234 "--use-compress-program="
222 "--verify" 235 "--verbose"
223 "--version" 236 "--verify"
224 "--volno-file="))) 237 "--version"
225 (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")) 238 "--volno-file=")))
226 (cond 239 (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz"))
227 ((pcomplete-match "\\`--after-date=" 0) 240 (cond
228 (pcomplete-here*)) 241 ((pcomplete-match "\\`--after-date=" 0)
229 ((pcomplete-match "\\`--backup=" 0) 242 (pcomplete-here*))
230 (pcomplete-here*)) 243 ((pcomplete-match "\\`--backup=" 0)
231 ((pcomplete-match "\\`--blocking-factor=" 0) 244 (pcomplete-here*))
232 (pcomplete-here*)) 245 ((pcomplete-match "\\`--blocking-factor=" 0)
233 ((pcomplete-match "\\`--directory=\\(.*\\)" 0) 246 (pcomplete-here*))
234 (pcomplete-here* (pcomplete-dirs) 247 ((pcomplete-match "\\`--directory=\\(.*\\)" 0)
235 (pcomplete-match-string 1 0))) 248 (pcomplete-here* (pcomplete-dirs)
236 ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0) 249 (pcomplete-match-string 1 0)))
237 (pcomplete-here* (pcomplete-entries) 250 ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0)
238 (pcomplete-match-string 1 0))) 251 (pcomplete-here* (pcomplete-entries)
239 ((pcomplete-match "\\`--exclude=" 0) 252 (pcomplete-match-string 1 0)))
240 (pcomplete-here*)) 253 ((pcomplete-match "\\`--exclude=" 0)
241 ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0) 254 (pcomplete-here*))
242 (setq complete-within t)) 255 ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0)
243 ((pcomplete-match "\\`--file=\\(.*\\)" 0) 256 (setq complete-within t))
244 (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp) 257 ((pcomplete-match "\\`--file=\\(.*\\)" 0)
245 (pcomplete-match-string 1 0))) 258 (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp)
246 ((pcomplete-match "\\`--files-from=\\(.*\\)" 0) 259 (pcomplete-match-string 1 0)))
247 (pcomplete-here* (pcomplete-entries) 260 ((pcomplete-match "\\`--files-from=\\(.*\\)" 0)
248 (pcomplete-match-string 1 0))) 261 (pcomplete-here* (pcomplete-entries)
249 ((pcomplete-match "\\`--group=\\(.*\\)" 0) 262 (pcomplete-match-string 1 0)))
250 (pcomplete-here* (pcmpl-unix-group-names) 263 ((pcomplete-match "\\`--group=\\(.*\\)" 0)
251 (pcomplete-match-string 1 0))) 264 (pcomplete-here* (pcmpl-unix-group-names)
252 ((pcomplete-match "\\`--info-script=\\(.*\\)" 0) 265 (pcomplete-match-string 1 0)))
253 (pcomplete-here* (pcomplete-entries) 266 ((pcomplete-match "\\`--info-script=\\(.*\\)" 0)
254 (pcomplete-match-string 1 0))) 267 (pcomplete-here* (pcomplete-entries)
255 ((pcomplete-match "\\`--label=" 0) 268 (pcomplete-match-string 1 0)))
256 (pcomplete-here*)) 269 ((pcomplete-match "\\`--label=" 0)
257 ((pcomplete-match "\\`--mode=" 0) 270 (pcomplete-here*))
258 (pcomplete-here*)) 271 ((pcomplete-match "\\`--mode=" 0)
259 ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0) 272 (pcomplete-here*))
260 (pcomplete-here* (pcomplete-entries) 273 ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0)
261 (pcomplete-match-string 1 0))) 274 (pcomplete-here* (pcomplete-entries)
262 ((pcomplete-match "\\`--newer=" 0) 275 (pcomplete-match-string 1 0)))
263 (pcomplete-here*)) 276 ((pcomplete-match "\\`--newer=" 0)
264 ((pcomplete-match "\\`--owner=\\(.*\\)" 0) 277 (pcomplete-here*))
265 (pcomplete-here* (pcmpl-unix-user-names) 278 ((pcomplete-match "\\`--owner=\\(.*\\)" 0)
266 (pcomplete-match-string 1 0))) 279 (pcomplete-here* (pcmpl-unix-user-names)
267 ((pcomplete-match "\\`--record-size=" 0) 280 (pcomplete-match-string 1 0)))
268 (pcomplete-here*)) 281 ((pcomplete-match "\\`--record-size=" 0)
269 ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0) 282 (pcomplete-here*))
270 (pcomplete-here* (funcall pcomplete-command-completion-function) 283 ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0)
271 (pcomplete-match-string 1 0))) 284 (pcomplete-here* (funcall pcomplete-command-completion-function)
272 ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0) 285 (pcomplete-match-string 1 0)))
273 (pcomplete-here* (pcomplete-entries) 286 ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0)
274 (pcomplete-match-string 1 0))) 287 (pcomplete-here* (pcomplete-entries)
275 ((pcomplete-match "\\`--suffix=" 0) 288 (pcomplete-match-string 1 0)))
276 (pcomplete-here*)) 289 ((pcomplete-match "\\`--suffix=" 0)
277 ((pcomplete-match "\\`--tape-length=" 0) 290 (pcomplete-here*))
278 (pcomplete-here*)) 291 ((pcomplete-match "\\`--tape-length=" 0)
279 ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0) 292 (pcomplete-here*))
280 (pcomplete-here* (funcall pcomplete-command-completion-function) 293 ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0)
281 (pcomplete-match-string 1 0))) 294 (pcomplete-here* (funcall pcomplete-command-completion-function)
282 ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0) 295 (pcomplete-match-string 1 0)))
283 (pcomplete-here* (pcomplete-entries) 296 ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0)
284 (pcomplete-match-string 1 0))))) 297 (pcomplete-here* (pcomplete-entries)
285 (setq pcomplete-suffix-list (cdr pcomplete-suffix-list)) 298 (pcomplete-match-string 1 0))))))
286 (unless saw-option 299 (unless saw-option
287 (pcomplete-here 300 (pcomplete-here
288 (mapcar 'char-to-string 301 (mapcar 'char-to-string
@@ -291,15 +304,16 @@
291 (if (pcomplete-match "[xt]" 'first 1) 304 (if (pcomplete-match "[xt]" 'first 1)
292 (setq complete-within t))) 305 (setq complete-within t)))
293 (pcomplete-here (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp)) 306 (pcomplete-here (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp))
294 (setq pcmpl-gnu-tar-buffer (find-file-noselect (pcomplete-arg 1)))
295 (while (pcomplete-here 307 (while (pcomplete-here
296 (if complete-within 308 (if (and complete-within
297 (with-current-buffer pcmpl-gnu-tar-buffer 309 (let* ((fa (file-attributes (pcomplete-arg 1)))
298 (mapcar 310 (size (nth 7 fa)))
299 (function 311 (and (numberp size)
300 (lambda (entry) 312 (< size large-file-warning-threshold))))
301 (tar-header-name entry))) 313 (completion-table-dynamic
302 tar-parse-info)) 314 (lambda (string)
315 (pcmpl-gnu-with-file-buffer (pcomplete-arg 1)
316 (mapcar #'tar-header-name tar-parse-info))))
303 (pcomplete-entries)) 317 (pcomplete-entries))
304 nil 'identity)))) 318 nil 'identity))))
305 319