/[emacs]/emacs/lisp/dired-aux.el
ViewVC logotype

Diff of /emacs/lisp/dired-aux.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.100 by rms, Fri Mar 29 14:44:07 2002 UTC revision 1.101 by pot, Wed Apr 17 09:54:47 2002 UTC
# Line 43  Line 43 
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'.
# Line 102  With prefix arg, prompt for argument SWI Line 105  With prefix arg, prompt for argument SWI
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))
# Line 355  the list of file names explicitly with t Line 358  the list of file names explicitly with t
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? "))
# Line 395  the list of file names explicitly with t Line 400  the list of file names explicitly with t
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
# Line 576  Otherwise, the rule is a compression rul Line 581  Otherwise, the rule is a compression rul
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
# Line 847  a prefix arg lets you edit the `ls' swit Line 852  a prefix arg lets you edit the `ls' swit
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
# Line 2013  with the command \\[tags-loop-continue]. Line 2018  with the command \\[tags-loop-continue].
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))

Legend:
Removed from v.1.100  
changed lines
  Added in v.1.101

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26