X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d75ffb4ed0b2e72a9361a07d16a5c884a9459728..34dc21db6e57ebbad81a196002fcd3cc557f096e:/lisp/dired-aux.el diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 6186f762e0..1129dfd89f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,10 +1,10 @@ ;;; dired-aux.el --- less commonly used parts of dired -;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2012 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2014 Free Software +;; Foundation, Inc. ;; Author: Sebastian Kremer . -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: files ;; Package: emacs @@ -54,29 +54,41 @@ into this list; they also should call `dired-log' to log the errors.") ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with file FILE using `diff'. -FILE defaults to the file at the mark. (That's the mark set by -\\[set-mark-command], not by Dired's \\[dired-mark] command.) -The prompted-for FILE is the first file given to `diff'. -With prefix arg, prompt for second argument SWITCHES, -which is the string of command switches for `diff'." +If called interactively, prompt for FILE. If the file at point +has a backup file, use that as the default. If the file at point +is a backup file, use its original. If the mark is active +in Transient Mark mode, use the file at the mark as the default. +\(That's the mark set by \\[set-mark-command], not by Dired's +\\[dired-mark] command.) + +FILE is the first file given to `diff'. The file at point +is the second file given to `diff'. + +With prefix arg, prompt for second argument SWITCHES, which is +the string of command switches for the third argument of `diff'." (interactive (let* ((current (dired-get-filename t)) + ;; Get the latest existing backup file or its original. + (oldf (if (backup-file-name-p current) + (file-name-sans-versions current) + (diff-latest-backup-file current))) ;; Get the file at the mark. - (file-at-mark (if (mark t) + (file-at-mark (if (and transient-mark-mode mark-active) (save-excursion (goto-char (mark t)) (dired-get-filename t t)))) + (default-file (or file-at-mark + (and oldf (file-name-nondirectory oldf)))) ;; Use it as default if it's not the same as the current file, - ;; and the target dir is the current dir or the mark is active. - (default (if (and (not (equal file-at-mark current)) + ;; and the target dir is current or there is a default file. + (default (if (and (not (equal default-file current)) (or (equal (dired-dwim-target-directory) (dired-current-directory)) - mark-active)) - file-at-mark)) + default-file)) + default-file)) (target-dir (if default (dired-current-directory) (dired-dwim-target-directory))) (defaults (dired-dwim-target-defaults (list current) target-dir))) - (require 'diff) (list (minibuffer-with-setup-hook (lambda () @@ -98,7 +110,10 @@ which is the string of command switches for `diff'." (equal (expand-file-name current file) (expand-file-name current)))) (error "Attempt to compare the file to itself")) - (diff file current switches))) + (if (and (backup-file-name-p current) + (equal file (file-name-sans-versions current))) + (diff current file switches) + (diff file current switches)))) ;;;###autoload (defun dired-backup-diff (&optional switches) @@ -236,10 +251,17 @@ List has a form of (file-name full-file-name (attribute-list))." ;; OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up'). ;; ARG describes which files to use, as in `dired-get-marked-files'. (let* ((files (dired-get-marked-files t arg)) - (default (and (eq op-symbol 'touch) - (stringp (car files)) - (format-time-string "%Y%m%d%H%M.%S" - (nth 5 (file-attributes (car files)))))) + ;; The source of default file attributes is the file at point. + (default-file (dired-get-filename t t)) + (default (when default-file + (cond ((eq op-symbol 'touch) + (format-time-string + "%Y%m%d%H%M.%S" + (nth 5 (file-attributes default-file)))) + ((eq op-symbol 'chown) + (nth 2 (file-attributes default-file 'string))) + ((eq op-symbol 'chgrp) + (nth 3 (file-attributes default-file 'string)))))) (prompt (concat "Change " attribute-name " of %s to" (if (eq op-symbol 'touch) " (default now): " @@ -257,11 +279,14 @@ List has a form of (file-name full-file-name (attribute-list))." (function dired-check-process) (append (list operation program) - (unless (string-equal new-attribute "") + (unless (or (string-equal new-attribute "") + ;; Use `eq' instead of `equal' + ;; to detect empty input (bug#12399). + (eq new-attribute default)) (if (eq op-symbol 'touch) (list "-t" new-attribute) (list new-attribute))) - (if (string-match "gnu" system-configuration) + (if (string-match-p "gnu" system-configuration) '("--") nil)) files)) (dired-do-redisplay arg);; moves point if ARG is an integer @@ -273,11 +298,15 @@ List has a form of (file-name full-file-name (attribute-list))." ;;;###autoload (defun dired-do-chmod (&optional arg) "Change the mode of the marked (or next ARG) files. -Symbolic modes like `g+w' are allowed." +Symbolic modes like `g+w' are allowed. +Type M-n to pull the file attributes of the file at point +into the minibuffer." (interactive "P") (let* ((files (dired-get-marked-files t arg)) - (modestr (and (stringp (car files)) - (nth 8 (file-attributes (car files))))) + ;; The source of default file attributes is the file at point. + (default-file (dired-get-filename t t)) + (modestr (when default-file + (nth 8 (file-attributes default-file)))) (default (and (stringp modestr) (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr) @@ -291,11 +320,14 @@ Symbolic modes like `g+w' are allowed." "Change mode of %s to: " nil 'chmod arg files default)) num-modes) - (cond ((equal modes "") + (cond ((or (equal modes "") + ;; Use `eq' instead of `equal' + ;; to detect empty input (bug#12399). + (eq modes default)) ;; We used to treat empty input as DEFAULT, but that is not ;; such a good idea (Bug#9361). (error "No file mode specified")) - ((string-match "^[0-7]+" modes) + ((string-match-p "^[0-7]+" modes) (setq num-modes (string-to-number modes 8)))) (dolist (file files) @@ -307,7 +339,9 @@ Symbolic modes like `g+w' are allowed." ;;;###autoload (defun dired-do-chgrp (&optional arg) - "Change the group of the marked (or next ARG) files." + "Change the group of the marked (or next ARG) files. +Type M-n to pull the file attributes of the file at point +into the minibuffer." (interactive "P") (if (memq system-type '(ms-dos windows-nt)) (error "chgrp not supported on this system")) @@ -315,7 +349,9 @@ Symbolic modes like `g+w' are allowed." ;;;###autoload (defun dired-do-chown (&optional arg) - "Change the owner of the marked (or next ARG) files." + "Change the owner of the marked (or next ARG) files. +Type M-n to pull the file attributes of the file at point +into the minibuffer." (interactive "P") (if (memq system-type '(ms-dos windows-nt)) (error "chown not supported on this system")) @@ -324,7 +360,9 @@ Symbolic modes like `g+w' are allowed." ;;;###autoload (defun dired-do-touch (&optional arg) "Change the timestamp of the marked (or next ARG) files. -This calls touch." +This calls touch. +Type M-n to pull the file attributes of the file at point +into the minibuffer." (interactive "P") (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg)) @@ -377,6 +415,12 @@ Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default." (interactive "P") (let* ((file-list (dired-get-marked-files t arg)) + (lpr-switches + (if (and (stringp printer-name) + (string< "" printer-name)) + (cons (concat lpr-printer-switch printer-name) + lpr-switches) + lpr-switches)) (command (dired-mark-read-string "Print %s with: " (mapconcat 'identity @@ -462,7 +506,7 @@ with a prefix argument." (goto-char (point-min)) (while (not (eobp)) (save-excursion - (and (not (looking-at dired-re-dir)) + (and (not (looking-at-p dired-re-dir)) (not (eolp)) (setq file (dired-get-filename nil t)) ; nil on non-file (progn (end-of-line) @@ -492,7 +536,7 @@ with a prefix argument." dired-file-version-alist))))))) (defun dired-trample-file-versions (fn) - (let* ((start-vn (string-match "\\.~[0-9]+~$" fn)) + (let* ((start-vn (string-match-p "\\.~[0-9]+~$" fn)) base-version-list) (and start-vn (setq base-version-list ; there was a base version to which @@ -564,7 +608,7 @@ The output appears in the buffer `*Async Shell Command*'." (dired-read-shell-command "& on %s: " current-prefix-arg files) current-prefix-arg files))) - (unless (string-match "&[ \t]*\\'" command) + (unless (string-match-p "&[ \t]*\\'" command) (setq command (concat command " &"))) (dired-do-shell-command command arg file-list)) @@ -625,10 +669,10 @@ can be produced by `dired-get-marked-files', for example." (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (let* ((on-each (not (string-match dired-star-subst-regexp command))) - (no-subst (not (string-match dired-quark-subst-regexp command))) - (star (string-match "\\*" command)) - (qmark (string-match "\\?" command))) + (let* ((on-each (not (string-match-p dired-star-subst-regexp command))) + (no-subst (not (string-match-p dired-quark-subst-regexp command))) + (star (string-match-p "\\*" command)) + (qmark (string-match-p "\\?" command))) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. (if (cond ((not (or on-each no-subst)) @@ -675,8 +719,8 @@ can be produced by `dired-get-marked-files', for example." (substring command 0 (match-beginning 0)) command)) (stuff-it - (if (or (string-match dired-star-subst-regexp command) - (string-match dired-quark-subst-regexp command)) + (if (or (string-match-p dired-star-subst-regexp command) + (string-match-p dired-quark-subst-regexp command)) (lambda (x) (let ((retval command)) (while (string-match @@ -802,9 +846,7 @@ command with a prefix argument (the value does not matter)." (if new-file (let ((start (point))) ;; Remove any preexisting entry for the name NEW-FILE. - (condition-case nil - (dired-remove-entry new-file) - (error nil)) + (ignore-errors (dired-remove-entry new-file)) (goto-char start) ;; Now replace the current line with an entry for NEW-FILE. (dired-update-file-line new-file) nil) @@ -845,7 +887,7 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") ;; See if any suffix rule matches this file name. (while suffixes (let (case-fold-search) - (if (string-match (car (car suffixes)) file) + (if (string-match-p (car (car suffixes)) file) (setq suffix (car suffixes) suffixes nil)) (setq suffixes (cdr suffixes)))) ;; If so, compute desired new name. @@ -1105,16 +1147,16 @@ files matching `dired-omit-regexp'." ;; Avoid calling ls for files that are going to be omitted anyway. (let ((omit-re (dired-omit-regexp))) (or (string= omit-re "") - (not (string-match omit-re - (cond - ((eq 'no-dir dired-omit-localp) - filename) - ((eq t dired-omit-localp) - (dired-make-relative filename)) - (t - (dired-make-absolute - filename - (file-name-directory filename))))))))) + (not (string-match-p omit-re + (cond + ((eq 'no-dir dired-omit-localp) + filename) + ((eq t dired-omit-localp) + (dired-make-relative filename)) + (t + (dired-make-absolute + filename + (file-name-directory filename))))))))) ;; Do it! (progn (setq filename (directory-file-name filename)) @@ -1142,7 +1184,7 @@ files matching `dired-omit-regexp'." ;; else try to find correct place to insert (if (dired-goto-subdir directory) (progn ;; unhide if necessary - (if (looking-at "\r") + (if (looking-at-p "\r") ;; Point is at end of subdir line. (dired-unhide-subdir)) ;; found - skip subdir and `total' line @@ -1301,9 +1343,7 @@ Special value `always' suppresses confirmation." (eq t (car attrs)) (or (eq recursive 'always) (yes-or-no-p (format "Recursive copies of %s? " from)))) - ;; This is a directory. (copy-directory from to preserve-time) - ;; Not a directory. (or top (dired-handle-overwrite to)) (condition-case err (if (stringp (car attrs)) @@ -2052,7 +2092,7 @@ This function takes some pains to conform to `ls -lR' output." (and (not switches) cons (setq switches (cdr cons))) (dired-insert-subdir-validate dirname switches) ;; case-fold-search is nil now, so we can test for capital `R': - (if (setq switches-have-R (and switches (string-match "R" switches))) + (if (setq switches-have-R (and switches (string-match-p "R" switches))) ;; avoid duplicated subdirs (setq mark-alist (dired-kill-tree dirname t))) (if elt @@ -2090,8 +2130,8 @@ This function takes some pains to conform to `ls -lR' output." (mapcar (function (lambda (x) - (or (eq (null (string-match x real-switches)) - (null (string-match x dired-actual-switches))) + (or (eq (null (string-match-p x real-switches)) + (null (string-match-p x dired-actual-switches))) (error "Can't have dirs with and without -%s switches together" x)))) ;; all switches that make a difference to dired-get-filename: @@ -2132,7 +2172,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." (defun dired-insert-subdir-newpos (new-dir) ;; Find pos for new subdir, according to tree order. ;;(goto-char (point-max)) - (let ((alist dired-subdir-alist) elt dir pos new-pos) + (let ((alist dired-subdir-alist) elt dir new-pos) (while alist (setq elt (car alist) alist (cdr alist) @@ -2383,7 +2423,7 @@ Lower levels are unaffected." (and selective-display (save-excursion (dired-goto-subdir dir) - (looking-at "\r")))) + (looking-at-p "\r")))) ;;;###autoload (defun dired-hide-subdir (arg) @@ -2453,20 +2493,21 @@ a file name. Otherwise, it searches the whole buffer without restrictions." :group 'dired :version "23.1") -(defvar dired-isearch-filter-predicate-orig nil) - -(defun dired-isearch-filenames-toggle () +(define-minor-mode dired-isearch-filenames-mode "Toggle file names searching on or off. When on, Isearch skips matches outside file names using the predicate `dired-isearch-filter-filenames' that matches only at file names. When off, it uses the original predicate." - (interactive) - (setq isearch-filter-predicate - (if (eq isearch-filter-predicate 'dired-isearch-filter-filenames) - dired-isearch-filter-predicate-orig - 'dired-isearch-filter-filenames)) - (setq isearch-success t isearch-adjusted t) - (isearch-update)) + nil nil nil + (if dired-isearch-filenames-mode + (add-function :before-while (local 'isearch-filter-predicate) + #'dired-isearch-filter-filenames + '((isearch-message-prefix . "filename "))) + (remove-function (local 'isearch-filter-predicate) + #'dired-isearch-filter-filenames)) + (when isearch-mode + (setq isearch-success t isearch-adjusted t) + (isearch-update))) ;;;###autoload (defun dired-isearch-filenames-setup () @@ -2475,43 +2516,36 @@ Intended to be added to `isearch-mode-hook'." (when (or (eq dired-isearch-filenames t) (and (eq dired-isearch-filenames 'dwim) (get-text-property (point) 'dired-filename))) - (setq isearch-message-prefix-add "filename ") - (define-key isearch-mode-map "\M-sf" 'dired-isearch-filenames-toggle) - (setq dired-isearch-filter-predicate-orig - (default-value 'isearch-filter-predicate)) - (setq-default isearch-filter-predicate 'dired-isearch-filter-filenames) + (define-key isearch-mode-map "\M-sff" 'dired-isearch-filenames-mode) + (dired-isearch-filenames-mode 1) (add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t))) (defun dired-isearch-filenames-end () "Clean up the Dired file name search after terminating isearch." - (setq isearch-message-prefix-add nil) - (define-key isearch-mode-map "\M-sf" nil) - (setq-default isearch-filter-predicate dired-isearch-filter-predicate-orig) + (define-key isearch-mode-map "\M-sff" nil) + (dired-isearch-filenames-mode -1) (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t)) (defun dired-isearch-filter-filenames (beg end) - "Test whether the current search hit is a visible file name. + "Test whether the current search hit is a file name. Return non-nil if the text from BEG to END is part of a file -name (has the text property `dired-filename') and is visible." - (and (isearch-filter-visible beg end) - (if dired-isearch-filenames - (text-property-not-all (min beg end) (max beg end) - 'dired-filename nil) - t))) +name (has the text property `dired-filename')." + (text-property-not-all (min beg end) (max beg end) + 'dired-filename nil)) ;;;###autoload (defun dired-isearch-filenames () "Search for a string using Isearch only in file names in the Dired buffer." (interactive) (let ((dired-isearch-filenames t)) - (isearch-forward))) + (isearch-forward nil t))) ;;;###autoload (defun dired-isearch-filenames-regexp () "Search for a regexp using Isearch only in file names in the Dired buffer." (interactive) (let ((dired-isearch-filenames t)) - (isearch-forward-regexp))) + (isearch-forward-regexp nil t))) ;; Functions for searching in tags style among marked files.