diff options
Diffstat (limited to 'lisp/arc-mode.el')
| -rw-r--r-- | lisp/arc-mode.el | 51 |
1 files changed, 29 insertions, 22 deletions
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index b1042be348c..632ae578523 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -101,6 +101,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) ;; ------------------------------------------------------------------------- ;;; Section: Configuration. @@ -431,12 +432,8 @@ be added." ;; Let mouse-1 follow the link. (define-key map [follow-link] 'mouse-face) - (if (fboundp 'command-remapping) - (progn - (define-key map [remap advertised-undo] 'archive-undo) - (define-key map [remap undo] 'archive-undo)) - (substitute-key-definition 'advertised-undo 'archive-undo map global-map) - (substitute-key-definition 'undo 'archive-undo map global-map)) + (define-key map [remap advertised-undo] #'archive-undo) + (define-key map [remap undo] #'archive-undo) (define-key map [mouse-2] 'archive-extract) @@ -621,12 +618,8 @@ OLDMODE will be modified accordingly just like chmod(2) would have done." (defun archive-unixdate (low high) "Stringify Unix (LOW HIGH) date." - (let* ((time (list high low)) - (str (current-time-string time))) - (format "%s-%s-%s" - (substring str 8 10) - (substring str 4 7) - (format-time-string "%Y" time)))) + (let ((system-time-locale "C")) + (format-time-string "%e-%b-%Y" (list high low)))) (defun archive-unixtime (low high) "Stringify Unix (LOW HIGH) time." @@ -1071,7 +1064,8 @@ NEW-NAME." #'archive--file-desc-ext-file-name (or (archive-get-marked ?*) (list (archive-get-descr)))))) (list names - (read-file-name (format "Copy %s to: " (string-join names ", ")))))) + (read-file-name (format "Copy %s to: " (string-join names ", ")) + nil default-directory)))) (unless (consp files) (setq files (list files))) (when (and (> (length files) 1) @@ -1079,22 +1073,31 @@ NEW-NAME." (user-error "Can't copy a list of files to a single file")) (save-excursion (dolist (file files) - (let ((write-to (if (file-directory-p new-name) - (expand-file-name file new-name) - new-name))) + (let* ((write-to (if (file-directory-p new-name) + (expand-file-name file new-name) + new-name)) + (write-to-dir (file-name-directory write-to))) (when (and (file-exists-p write-to) (not (yes-or-no-p (format "%s already exists; overwrite? " write-to)))) (user-error "Not overwriting %s" write-to)) + (unless (file-directory-p write-to-dir) + (make-directory write-to-dir t)) (archive-goto-file file) (let* ((descr (archive-get-descr)) (archive (buffer-file-name)) (extractor (archive-name "extract")) - (ename (archive--file-desc-ext-file-name descr))) - (with-temp-buffer - (set-buffer-multibyte nil) - (archive--extract-file extractor archive ename) - (write-region (point-min) (point-max) write-to))))))) + (ename (archive--file-desc-ext-file-name descr)) + ;; If the archive is remote, we have to copy it to a + ;; local file first to make extraction work. + (copy (archive-maybe-copy archive))) + (unwind-protect + (with-temp-buffer + (set-buffer-multibyte nil) + (archive--extract-file extractor copy ename) + (write-region (point-min) (point-max) write-to)) + (unless (equal copy archive) + (delete-file copy)))))))) (defun archive-extract (&optional other-window-p event) "In archive mode, extract this entry of the archive into its own buffer." @@ -1324,6 +1327,8 @@ NEW-NAME." ;;; Section: IO stuff (defun archive-write-file-member () + (unless (buffer-live-p archive-superior-buffer) + (error "The archive buffer no longer exists; can't save")) (save-excursion (save-restriction (message "Updating archive...") @@ -1348,7 +1353,8 @@ NEW-NAME." t) (defun archive-*-write-file-member (archive descr command) - (let* ((ename (archive--file-desc-ext-file-name descr)) + (let* ((archive (expand-file-name archive)) + (ename (archive--file-desc-ext-file-name descr)) (tmpfile (expand-file-name ename archive-tmpdir)) (top (directory-file-name (file-name-as-directory archive-tmpdir))) (default-directory (file-name-as-directory top))) @@ -1372,6 +1378,7 @@ NEW-NAME." (setq ename (encode-coding-string ename archive-file-name-coding-system)) (let* ((coding-system-for-write 'no-conversion) + (default-directory (file-name-as-directory archive-tmpdir)) (exitcode (apply #'call-process (car command) nil |