Mercurial > emacs
comparison lisp/dired-aux.el @ 44648:6c3a3cb75b95
* dired-aux.el (dired-star-subst-regexp,
dired-quark-subst-regexp): New constants.
(dired-do-shell-command, dired-shell-stuff-it): Use them.
(dired-do-shell-command): Raise an error if both `*' and `?'
substitution marks are used in the same command.
(dired-shell-stuff-it): Substitute all instances of `*' and `?'
in a command given via dired-do-shell-command.
| author | Francesco Potortì <pot@gnu.org> |
|---|---|
| date | Wed, 17 Apr 2002 09:54:47 +0000 |
| parents | 1541aec5edea |
| children | 307e91e0f260 |
comparison
equal
deleted
inserted
replaced
| 44647:844590891e89 | 44648:6c3a3cb75b95 |
|---|---|
| 40 (eval-when-compile (require 'dired)) | 40 (eval-when-compile (require 'dired)) |
| 41 | 41 |
| 42 ;;; 15K | 42 ;;; 15K |
| 43 ;;;###begin dired-cmd.el | 43 ;;;###begin dired-cmd.el |
| 44 ;; Diffing and compressing | 44 ;; Diffing and compressing |
| 45 | |
| 46 (defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)") | |
| 47 (defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)") | |
| 45 | 48 |
| 46 ;;;###autoload | 49 ;;;###autoload |
| 47 (defun dired-diff (file &optional switches) | 50 (defun dired-diff (file &optional switches) |
| 48 "Compare file at point with file FILE using `diff'. | 51 "Compare file at point with file FILE using `diff'. |
| 49 FILE defaults to the file at the mark. (That's the mark set by | 52 FILE defaults to the file at the mark. (That's the mark set by |
| 100 (operation (concat program " " new-attribute)) | 103 (operation (concat program " " new-attribute)) |
| 101 failures) | 104 failures) |
| 102 (setq failures | 105 (setq failures |
| 103 (dired-bunch-files 10000 | 106 (dired-bunch-files 10000 |
| 104 (function dired-check-process) | 107 (function dired-check-process) |
| 105 (append | 108 (append |
| 106 (list operation program new-attribute) | 109 (list operation program new-attribute) |
| 107 (if (string-match "gnu" system-configuration) | 110 (if (string-match "gnu" system-configuration) |
| 108 '("--") nil)) | 111 '("--") nil)) |
| 109 files)) | 112 files)) |
| 110 (dired-do-redisplay arg);; moves point if ARG is an integer | 113 (dired-do-redisplay arg);; moves point if ARG is an integer |
| 353 "%s: ") | 356 "%s: ") |
| 354 current-prefix-arg | 357 current-prefix-arg |
| 355 files) | 358 files) |
| 356 current-prefix-arg | 359 current-prefix-arg |
| 357 files))) | 360 files))) |
| 358 (let* ((on-each (not (string-match "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)" command))) | 361 (let* ((on-each (not (string-match dired-star-subst-regexp command))) |
| 359 (subst (not (string-match "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)" command))) | 362 (subst (not (string-match dired-quark-subst-regexp command))) |
| 360 (star (not (string-match "\\*" command))) | 363 (star (not (string-match "\\*" command))) |
| 361 (qmark (not (string-match "\\?" command)))) | 364 (qmark (not (string-match "\\?" command)))) |
| 362 ;; Get confirmation for wildcards that may have been meant | 365 ;; Get confirmation for wildcards that may have been meant |
| 363 ;; to control substitution of a file name or the file name list. | 366 ;; to control substitution of a file name or the file name list. |
| 364 (if (cond ((and star (not on-each)) | 367 (if (cond ((not (or on-each subst)) |
| 368 (error "You can not combine `*' and `?' substitution marks")) | |
| 369 ((and star (not on-each)) | |
| 365 (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? ")) | 370 (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? ")) |
| 366 ((and qmark (not subst)) | 371 ((and qmark (not subst)) |
| 367 (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? ")) | 372 (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? ")) |
| 368 (t)) | 373 (t)) |
| 369 (if on-each | 374 (if on-each |
| 393 ;; FILE-LIST's elements will be quoted for the shell." | 398 ;; FILE-LIST's elements will be quoted for the shell." |
| 394 ;; Might be redefined for smarter things and could then use RAW-ARG | 399 ;; Might be redefined for smarter things and could then use RAW-ARG |
| 395 ;; (coming from interactive P and currently ignored) to decide what to do. | 400 ;; (coming from interactive P and currently ignored) to decide what to do. |
| 396 ;; Smart would be a way to access basename or extension of file names. | 401 ;; Smart would be a way to access basename or extension of file names. |
| 397 (let ((stuff-it | 402 (let ((stuff-it |
| 398 (cond ((string-match "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)" command) | 403 (if (or (string-match dired-star-subst-regexp command) |
| 399 (lambda (x) | 404 (string-match dired-quark-subst-regexp command)) |
| 400 (string-match "\\(^\\|[ \t]\\)\\(\\*\\)\\([ \t]\\|$\\)" command) | 405 (lambda (x) |
| 401 (replace-match x t t command 2))) | 406 (let ((retval command)) |
| 402 ((string-match "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)" command) | 407 (while (string-match |
| 403 (lambda (x) | 408 "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) |
| 404 (string-match "\\(^\\|[ \t]\\)\\(\\?\\)\\([ \t]\\|$\\)" command) | 409 (setq retval (replace-match x t t retval 2))) |
| 405 (replace-match x t t command 2))) | 410 retval)) |
| 406 (t (lambda (x) (concat command dired-mark-separator x)))))) | 411 (lambda (x) (concat command dired-mark-separator x))))) |
| 407 (if on-each | 412 (if on-each |
| 408 (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";") | 413 (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";") |
| 409 (let ((files (mapconcat 'shell-quote-argument | 414 (let ((files (mapconcat 'shell-quote-argument |
| 410 file-list dired-mark-separator))) | 415 file-list dired-mark-separator))) |
| 411 (if (> (length file-list) 1) | 416 (if (> (length file-list) 1) |
| 574 (let (case-fold-search) | 579 (let (case-fold-search) |
| 575 (if (string-match (car (car suffixes)) file) | 580 (if (string-match (car (car suffixes)) file) |
| 576 (setq suffix (car suffixes) suffixes nil)) | 581 (setq suffix (car suffixes) suffixes nil)) |
| 577 (setq suffixes (cdr suffixes)))) | 582 (setq suffixes (cdr suffixes)))) |
| 578 ;; If so, compute desired new name. | 583 ;; If so, compute desired new name. |
| 579 (if suffix | 584 (if suffix |
| 580 (setq newname (concat (substring file 0 (match-beginning 0)) | 585 (setq newname (concat (substring file 0 (match-beginning 0)) |
| 581 (nth 1 suffix)))) | 586 (nth 1 suffix)))) |
| 582 (cond (handler | 587 (cond (handler |
| 583 (funcall handler 'dired-compress-file file)) | 588 (funcall handler 'dired-compress-file file)) |
| 584 ((file-symlink-p file) | 589 ((file-symlink-p file) |
| 845 (concat dired-actual-switches "d"))) | 850 (concat dired-actual-switches "d"))) |
| 846 ;; Compensate for a bug in ange-ftp. | 851 ;; Compensate for a bug in ange-ftp. |
| 847 ;; It inserts the file's absolute name, rather than | 852 ;; It inserts the file's absolute name, rather than |
| 848 ;; the relative one. That may be hard to fix since it | 853 ;; the relative one. That may be hard to fix since it |
| 849 ;; is probably controlled by something in ftp. | 854 ;; is probably controlled by something in ftp. |
| 850 (goto-char opoint) | 855 (goto-char opoint) |
| 851 (let ((inserted-name (dired-get-filename 'verbatim))) | 856 (let ((inserted-name (dired-get-filename 'verbatim))) |
| 852 (if (file-name-directory inserted-name) | 857 (if (file-name-directory inserted-name) |
| 853 (progn | 858 (progn |
| 854 (end-of-line) | 859 (end-of-line) |
| 855 (delete-char (- (length inserted-name))) | 860 (delete-char (- (length inserted-name))) |
| 2011 | 2016 |
| 2012 ;;;###autoload | 2017 ;;;###autoload |
| 2013 (defun dired-show-file-type (file &optional deref-symlinks) | 2018 (defun dired-show-file-type (file &optional deref-symlinks) |
| 2014 "Print the type of FILE, according to the `file' command. | 2019 "Print the type of FILE, according to the `file' command. |
| 2015 If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is | 2020 If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is |
| 2016 true then the type of the file linked to by FILE is printed instead." | 2021 true then the type of the file linked to by FILE is printed instead." |
| 2017 (interactive (list (dired-get-filename t) current-prefix-arg)) | 2022 (interactive (list (dired-get-filename t) current-prefix-arg)) |
| 2018 (with-temp-buffer | 2023 (with-temp-buffer |
| 2019 (if deref-symlinks | 2024 (if deref-symlinks |
| 2020 (call-process "file" nil t t "-L" file) | 2025 (call-process "file" nil t t "-L" file) |
| 2021 (call-process "file" nil t t file)) | 2026 (call-process "file" nil t t file)) |
| 2022 (when (bolp) | 2027 (when (bolp) |
| 2023 (backward-delete-char 1)) | 2028 (backward-delete-char 1)) |