procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make dired-do-compress work for *.zip files

Browse source 
* lisp/dired-aux.el (dired-check-process): Transform the top-level
  comment into a docstring.
(dired-shell-command): New command. This mirrors
`dired-check-process', but is more user-friendly for passing
arguments.
(dired-compress-file-suffixes): Allow to specify the command switches
along with input (%i) and output (%o) inside the PROGRAM part.
Add an entry for *.zip files, and update the entry for *.tar.gz files
to the new style. Update the docstring.
(dired-compress-file): When PROGRAM matches %i or %o, use the new
logic.
(dired-update-file-line): Avoid an error when at end of buffer.

Fixes Bug#21637
This commit is contained in:
Oleh Krehel 2015-10-16 13:57:22 +02:00
parent b0d190fbe2
commit 7175459da1
1 changed files with 60 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
lisp/dired-aux.el
View file

@ -762,12 +762,12 @@ can be produced by `dired-get-marked-files', for example."
(defun dired-check-process (msg program &rest arguments)
; "Display MSG while running PROGRAM, and check for output.
;Remaining arguments are strings passed as command arguments to PROGRAM.
; On error, insert output
; in a log buffer and return the offending ARGUMENTS or PROGRAM.
; Caller can cons up a list of failed args.
;Else returns nil for success."
"Display MSG while running PROGRAM, and check for output.
Remaining arguments are strings passed as command arguments to PROGRAM.
On error, insert output
in a log buffer and return the offending ARGUMENTS or PROGRAM.
Caller can cons up a list of failed args.
Else returns nil for success."
(let (err-buffer err (dir default-directory))
(message "%s..." msg)
(save-excursion
@ -785,6 +785,23 @@ can be produced by `dired-get-marked-files', for example."
(kill-buffer err-buffer)
(message "%s...done" msg)
nil))))
(defun dired-shell-command (cmd)
"Run CMD, and check for output.
On error, pop up the log buffer."
(let ((out-buffer " *dired-check-process output*"))
(with-current-buffer (get-buffer-create out-buffer)
(erase-buffer)
(setq res
(process-file
shell-file-name
nil
t
nil
shell-command-switch
cmd)))
(unless (zerop res)
(pop-to-buffer out-buffer))))
;; Commands that delete or redisplay part of the dired buffer.
@ -864,7 +881,7 @@ command with a prefix argument (the value does not matter)."
from-file)))
(defvar dired-compress-file-suffixes
'(("\\.tar\\.gz" "" "tar" "-zxvf")
'(("\\.tar\\.gz\\'" "" "tar -zxvf %i")
("\\.gz\\'" "" "gunzip")
("\\.tgz\\'" ".tar" "gunzip")
("\\.Z\\'" "" "uncompress")
@ -875,16 +892,21 @@ command with a prefix argument (the value does not matter)."
("\\.tbz\\'" ".tar" "bunzip2")
("\\.bz2\\'" "" "bunzip2")
("\\.xz\\'" "" "unxz")
("\\.zip\\'" "" "unzip -o -d %o %i")
;; This item controls naming for compression.
("\\.tar\\'" ".tgz" nil))
"Control changes in file name suffixes for compression and uncompression.
Each element specifies one transformation rule, and has the form:
(REGEXP NEW-SUFFIX PROGRAM &rest ARGS)
(REGEXP NEW-SUFFIX PROGRAM)
The rule applies when the old file name matches REGEXP.
The new file name is computed by deleting the part that matches REGEXP
(as well as anything after that), then adding NEW-SUFFIX in its place.
If PROGRAM is non-nil, the rule is an uncompression rule,
and uncompression is done by running PROGRAM.
Within PROGRAM, %i denotes the input file, and %o denotes the
output file.
Otherwise, the rule is a compression rule, and compression is done with gzip.
ARGS are command switches passed to PROGRAM.")
@ -895,7 +917,8 @@ Return the name of the compressed or uncompressed file.
Return nil if no change in files."
(let ((handler (find-file-name-handler file 'dired-compress-file))
suffix newname
(suffixes dired-compress-file-suffixes))
(suffixes dired-compress-file-suffixes)
command)
;; See if any suffix rule matches this file name.
(while suffixes
(let (case-fold-search)
@ -910,13 +933,22 @@ Return nil if no change in files."
(funcall handler 'dired-compress-file file))
((file-symlink-p file)
nil)
((and suffix (nth 2 suffix))
;; We found an uncompression rule.
(when (not (apply 'dired-check-process
`(,(concat "Uncompressing " file)
,@(cddr suffix)
,file)))
newname))
((and suffix (setq command (nth 2 suffix)))
(if (string-match "%[io]" command)
(prog1 (setq newname (file-name-as-directory newname))
(dired-shell-command
(replace-regexp-in-string
"%o" newname
(replace-regexp-in-string
"%i" file
command))))
;; We found an uncompression rule.
(when (not
(dired-check-process
(concat "Uncompressing " file)
command
file))
newname)))
(t
;; We don't recognize the file as compressed, so compress it.
;; Try gzip; if we don't have that, use compress.
@ -931,8 +963,10 @@ Return nil if no change in files."
(not
(if (file-directory-p file)
(let ((default-directory (file-name-directory file)))
(dired-check-process (concat "Compressing " file)
"tar" "-czf" out-name (file-name-nondirectory file)))
(dired-check-process
(concat "Compressing " file)
"tar" "-czf"
out-name (file-name-nondirectory file)))
(dired-check-process (concat "Compressing " file)
"gzip" "-f" file)))
(or (file-exists-p out-name)
@ -1132,15 +1166,16 @@ See Info node `(emacs)Subdir switches' for more details."
;; here is faster than with dired-add-entry's optional arg).
;; Does not update other dired buffers. Use dired-relist-entry for that.
(let* ((opoint (line-beginning-position))
(char (char-after opoint))
(buffer-read-only))
(char (char-after opoint))
(buffer-read-only))
(delete-region opoint (progn (forward-line 1) (point)))
(if file
(progn
(dired-add-entry file nil t)
;; Replace space by old marker without moving point.
;; Faster than goto+insdel inside a save-excursion?
(subst-char-in-region opoint (1+ opoint) ?\040 char))))
(progn
(dired-add-entry file nil t)
;; Replace space by old marker without moving point.
;; Faster than goto+insdel inside a save-excursion?
(when char
(subst-char-in-region opoint (1+ opoint) ?\040 char)))))
(dired-move-to-filename))
;;;###autoload