43 |
;;;###begin dired-cmd.el |
;;;###begin dired-cmd.el |
44 |
;; Diffing and compressing |
;; Diffing and compressing |
45 |
|
|
46 |
|
(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)") |
47 |
|
(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)") |
48 |
|
|
49 |
;;;###autoload |
;;;###autoload |
50 |
(defun dired-diff (file &optional switches) |
(defun dired-diff (file &optional switches) |
51 |
"Compare file at point with file FILE using `diff'. |
"Compare file at point with file FILE using `diff'. |
105 |
(setq failures |
(setq failures |
106 |
(dired-bunch-files 10000 |
(dired-bunch-files 10000 |
107 |
(function dired-check-process) |
(function dired-check-process) |
108 |
(append |
(append |
109 |
(list operation program new-attribute) |
(list operation program new-attribute) |
110 |
(if (string-match "gnu" system-configuration) |
(if (string-match "gnu" system-configuration) |
111 |
'("--") nil)) |
'("--") nil)) |
358 |
files) |
files) |
359 |
current-prefix-arg |
current-prefix-arg |
360 |
files))) |
files))) |
361 |
(let* ((on-each (not (string-match "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)" command))) |
(let* ((on-each (not (string-match dired-star-subst-regexp command))) |
362 |
(subst (not (string-match "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)" command))) |
(subst (not (string-match dired-quark-subst-regexp command))) |
363 |
(star (not (string-match "\\*" command))) |
(star (not (string-match "\\*" command))) |
364 |
(qmark (not (string-match "\\?" command)))) |
(qmark (not (string-match "\\?" command)))) |
365 |
;; Get confirmation for wildcards that may have been meant |
;; Get confirmation for wildcards that may have been meant |
366 |
;; to control substitution of a file name or the file name list. |
;; to control substitution of a file name or the file name list. |
367 |
(if (cond ((and star (not on-each)) |
(if (cond ((not (or on-each subst)) |
368 |
|
(error "You can not combine `*' and `?' substitution marks")) |
369 |
|
((and star (not on-each)) |
370 |
(y-or-n-p "Confirm--do you mean to use `*' as a wildcard? ")) |
(y-or-n-p "Confirm--do you mean to use `*' as a wildcard? ")) |
371 |
((and qmark (not subst)) |
((and qmark (not subst)) |
372 |
(y-or-n-p "Confirm--do you mean to use `?' as a wildcard? ")) |
(y-or-n-p "Confirm--do you mean to use `?' as a wildcard? ")) |
400 |
;; (coming from interactive P and currently ignored) to decide what to do. |
;; (coming from interactive P and currently ignored) to decide what to do. |
401 |
;; Smart would be a way to access basename or extension of file names. |
;; Smart would be a way to access basename or extension of file names. |
402 |
(let ((stuff-it |
(let ((stuff-it |
403 |
(cond ((string-match "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)" command) |
(if (or (string-match dired-star-subst-regexp command) |
404 |
(lambda (x) |
(string-match dired-quark-subst-regexp command)) |
405 |
(string-match "\\(^\\|[ \t]\\)\\(\\*\\)\\([ \t]\\|$\\)" command) |
(lambda (x) |
406 |
(replace-match x t t command 2))) |
(let ((retval command)) |
407 |
((string-match "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)" command) |
(while (string-match |
408 |
(lambda (x) |
"\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) |
409 |
(string-match "\\(^\\|[ \t]\\)\\(\\?\\)\\([ \t]\\|$\\)" command) |
(setq retval (replace-match x t t retval 2))) |
410 |
(replace-match x t t command 2))) |
retval)) |
411 |
(t (lambda (x) (concat command dired-mark-separator x)))))) |
(lambda (x) (concat command dired-mark-separator x))))) |
412 |
(if on-each |
(if on-each |
413 |
(mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";") |
(mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";") |
414 |
(let ((files (mapconcat 'shell-quote-argument |
(let ((files (mapconcat 'shell-quote-argument |
581 |
(setq suffix (car suffixes) suffixes nil)) |
(setq suffix (car suffixes) suffixes nil)) |
582 |
(setq suffixes (cdr suffixes)))) |
(setq suffixes (cdr suffixes)))) |
583 |
;; If so, compute desired new name. |
;; If so, compute desired new name. |
584 |
(if suffix |
(if suffix |
585 |
(setq newname (concat (substring file 0 (match-beginning 0)) |
(setq newname (concat (substring file 0 (match-beginning 0)) |
586 |
(nth 1 suffix)))) |
(nth 1 suffix)))) |
587 |
(cond (handler |
(cond (handler |
852 |
;; It inserts the file's absolute name, rather than |
;; It inserts the file's absolute name, rather than |
853 |
;; the relative one. That may be hard to fix since it |
;; the relative one. That may be hard to fix since it |
854 |
;; is probably controlled by something in ftp. |
;; is probably controlled by something in ftp. |
855 |
(goto-char opoint) |
(goto-char opoint) |
856 |
(let ((inserted-name (dired-get-filename 'verbatim))) |
(let ((inserted-name (dired-get-filename 'verbatim))) |
857 |
(if (file-name-directory inserted-name) |
(if (file-name-directory inserted-name) |
858 |
(progn |
(progn |
2018 |
(defun dired-show-file-type (file &optional deref-symlinks) |
(defun dired-show-file-type (file &optional deref-symlinks) |
2019 |
"Print the type of FILE, according to the `file' command. |
"Print the type of FILE, according to the `file' command. |
2020 |
If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is |
If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is |
2021 |
true then the type of the file linked to by FILE is printed instead." |
true then the type of the file linked to by FILE is printed instead." |
2022 |
(interactive (list (dired-get-filename t) current-prefix-arg)) |
(interactive (list (dired-get-filename t) current-prefix-arg)) |
2023 |
(with-temp-buffer |
(with-temp-buffer |
2024 |
(if deref-symlinks |
(if deref-symlinks |
2025 |
(call-process "file" nil t t "-L" file) |
(call-process "file" nil t t "-L" file) |
2026 |
(call-process "file" nil t t file)) |
(call-process "file" nil t t file)) |