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)) |