Mercurial > emacs
comparison lisp/jka-compr.el @ 11635:b56f6afa16ec
(jka-compr-write-region): Handle the append
argument correctly when the can-append flag is false.
(jka-compr-write-region): Make temp-buffer name unique to this fn.
(jka-compr-file-local-copy): Ditto.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 01 May 1995 05:23:49 +0000 |
| parents | 710b5ce824c2 |
| children | a285eaa710ac |
comparison
equal
deleted
inserted
replaced
| 11634:820eaef29fae | 11635:b56f6afa16ec |
|---|---|
| 179 | 179 |
| 180 | 180 |
| 181 (put 'compression-error 'error-conditions '(compression-error file-error error)) | 181 (put 'compression-error 'error-conditions '(compression-error file-error error)) |
| 182 | 182 |
| 183 | 183 |
| 184 (defvar jka-compr-acceptable-retval-list '(0 141)) | 184 (defvar jka-compr-acceptable-retval-list '(0 2 141)) |
| 185 | 185 |
| 186 | 186 |
| 187 (defun jka-compr-error (prog args infile message &optional errfile) | 187 (defun jka-compr-error (prog args infile message &optional errfile) |
| 188 | 188 |
| 189 (let ((errbuf (get-buffer-create " *jka-compr-error*")) | 189 (let ((errbuf (get-buffer-create " *jka-compr-error*")) |
| 359 (compress-message (jka-compr-info-compress-message info)) | 359 (compress-message (jka-compr-info-compress-message info)) |
| 360 (uncompress-program (jka-compr-info-uncompress-program info)) | 360 (uncompress-program (jka-compr-info-uncompress-program info)) |
| 361 (uncompress-message (jka-compr-info-uncompress-message info)) | 361 (uncompress-message (jka-compr-info-uncompress-message info)) |
| 362 (compress-args (jka-compr-info-compress-args info)) | 362 (compress-args (jka-compr-info-compress-args info)) |
| 363 (uncompress-args (jka-compr-info-uncompress-args info)) | 363 (uncompress-args (jka-compr-info-uncompress-args info)) |
| 364 (temp-file (jka-compr-make-temp-name)) | |
| 365 (base-name (file-name-nondirectory visit-file)) | 364 (base-name (file-name-nondirectory visit-file)) |
| 366 cbuf temp-buffer) | 365 temp-file cbuf temp-buffer) |
| 367 | 366 |
| 368 (setq cbuf (current-buffer) | 367 (setq cbuf (current-buffer) |
| 369 temp-buffer (get-buffer-create " *jka-compr-temp*")) | 368 temp-buffer (get-buffer-create " *jka-compr-wr-temp*")) |
| 370 (set-buffer temp-buffer) | 369 (set-buffer temp-buffer) |
| 371 (widen) (erase-buffer) | 370 (widen) (erase-buffer) |
| 372 (set-buffer cbuf) | 371 (set-buffer cbuf) |
| 373 | 372 |
| 374 (and append | 373 (if (and append |
| 375 (not can-append) | 374 (not can-append) |
| 376 (file-exists-p filename) | 375 (file-exists-p filename)) |
| 377 (let* ((local-copy (file-local-copy filename)) | 376 |
| 378 (local-file (or local-copy filename))) | 377 (let* ((local-copy (file-local-copy filename)) |
| 379 | 378 (local-file (or local-copy filename))) |
| 380 (unwind-protect | 379 |
| 381 | 380 (setq temp-file local-file)) |
| 382 (progn | 381 |
| 383 | 382 (setq temp-file (jka-compr-make-temp-name))) |
| 384 (and | |
| 385 uncompress-message | |
| 386 (message "%s %s..." uncompress-message base-name)) | |
| 387 | |
| 388 (jka-compr-call-process uncompress-program | |
| 389 (concat uncompress-message | |
| 390 " " base-name) | |
| 391 local-file | |
| 392 temp-file | |
| 393 temp-buffer | |
| 394 uncompress-args) | |
| 395 (and | |
| 396 uncompress-message | |
| 397 (message "%s %s...done" uncompress-message base-name))) | |
| 398 | |
| 399 (and | |
| 400 local-copy | |
| 401 (file-exists-p local-copy) | |
| 402 (delete-file local-copy))))) | |
| 403 | 383 |
| 404 (and | 384 (and |
| 405 compress-message | 385 compress-message |
| 406 (message "%s %s..." compress-message base-name)) | 386 (message "%s %s..." compress-message base-name)) |
| 407 | 387 |
| 408 (jka-compr-run-real-handler 'write-region | 388 (jka-compr-run-real-handler 'write-region |
| 409 (list start end temp-file t 'dont)) | 389 (list start end temp-file t 'dont)) |
| 410 | 390 |
| 411 (jka-compr-call-process compress-program | 391 (jka-compr-call-process compress-program |
| 412 (concat compress-message | 392 (concat compress-message |
| 583 (uncompress-args (jka-compr-info-uncompress-args info)) | 563 (uncompress-args (jka-compr-info-uncompress-args info)) |
| 584 (base-name (file-name-nondirectory filename)) | 564 (base-name (file-name-nondirectory filename)) |
| 585 (local-copy | 565 (local-copy |
| 586 (jka-compr-run-real-handler 'file-local-copy (list filename))) | 566 (jka-compr-run-real-handler 'file-local-copy (list filename))) |
| 587 (temp-file (jka-compr-make-temp-name t)) | 567 (temp-file (jka-compr-make-temp-name t)) |
| 588 (temp-buffer (get-buffer-create " *jka-compr-temp*")) | 568 (temp-buffer (get-buffer-create " *jka-compr-flc-temp*")) |
| 589 (notfound nil) | 569 (notfound nil) |
| 590 (cbuf (current-buffer)) | 570 (cbuf (current-buffer)) |
| 591 local-file) | 571 local-file) |
| 592 | 572 |
| 593 (setq local-file (or local-copy filename)) | 573 (setq local-file (or local-copy filename)) |